Object.st
author Claus Gittinger <cg@exept.de>
Wed, 26 Apr 2006 13:13:22 +0200
changeset 9335 2dcbf8f91693
parent 9314 93bac344273f
child 9375 6cbc697095e7
permissions -rw-r--r--
*** empty log message ***
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
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7216
diff changeset
   525
!Object methodsFor:'Compatibility-ST80'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   526
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   527
isMetaclass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   528
    ^ self isMeta
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   529
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   530
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7216
diff changeset
   531
!Object methodsFor:'Compatibility-Squeak'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   532
6549
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   533
as:aSimilarClass
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   534
    "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
   535
     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
   536
     as the receiver.
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   537
     Otherwise, return the receiver."
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   538
8664491c4428 #as: returns the receiver if its class already matches
Claus Gittinger <cg@exept.de>
parents: 6537
diff changeset
   539
    self class == aSimilarClass ifTrue:[^ self].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   540
    ^ aSimilarClass newFrom:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   541
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   542
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   543
     #[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
   544
     #[1 2 3 4] as:Array
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   545
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   546
!
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
asString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   549
    ^ self printString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   550
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   551
9071
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   552
becomeForward:anotherObject
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   553
    self becomeSameAs:anotherObject
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   554
!
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   555
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   556
becomeForward:anotherObject copyHash:copyHash
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   557
    copyHash ifTrue:[ self error:'unsupported operation' ].
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   558
    self becomeSameAs:anotherObject
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   559
!
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   560
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   561
clone
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   562
    ^ self shallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   563
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   564
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   565
copyTwoLevel
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   566
    "one more level than a shallowCopy"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   567
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   568
    ^ self copyToLevel:2
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   569
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   570
    "
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   571
     |original copy elL1 elL2 elL3 copyOfElL1|
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   572
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   573
     original := Array new:3.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   574
     original at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   575
     original at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   576
     original at:3 put:(elL1 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   577
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   578
     elL1 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   579
     elL1 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   580
     elL1 at:3 put:(elL2 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   581
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   582
     elL2 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   583
     elL2 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   584
     elL2 at:3 put:(elL3 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   585
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   586
     elL3 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   587
     elL3 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   588
     elL3 at:3 put:(Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   589
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   590
     copy := original copyTwoLevel.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   591
     (original at:2) ~~ (copy at:2) ifFalse:[self halt].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   592
     (original at:3) ~~ (copy at:3) ifFalse:[self halt].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   593
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   594
     copyOfElL1 := copy at:3.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   595
     (elL1 at:2) == (copyOfElL1 at:2) ifFalse:[self halt].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   596
     (elL1 at:3) == (copyOfElL1 at:3) ifFalse:[self halt].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   597
    "
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   598
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   599
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   600
currentHand
5912
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   601
    "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
   602
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   603
    |w h|
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   604
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   605
    w := self currentWorld.
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   606
    h := w activeHand.
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   607
    h isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   608
        h := w hands first
5912
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   609
    ].
8e3d9ac02b3b *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5893
diff changeset
   610
    ^ h
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   611
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   612
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   613
currentWorld
7159
7964c345d74c Object currentWorld - recursion if Utilities is unloaded
Claus Gittinger <cg@exept.de>
parents: 7121
diff changeset
   614
    Utilities autoload.    
7964c345d74c Object currentWorld - recursion if Utilities is unloaded
Claus Gittinger <cg@exept.de>
parents: 7121
diff changeset
   615
    ^ Utilities currentWorld
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   616
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   617
7320
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   618
explore
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   619
    (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
   620
    ifTrue:[
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   621
        self inspect
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   622
    ]
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   623
!
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   624
9335
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   625
isInMemory
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   626
    "All normal objects are."
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   627
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   628
    ^ true
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   629
!
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   630
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   631
newTileMorphRepresentative
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   632
        ^ TileMorph new setLiteral: self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   633
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   634
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   635
stringForReadout
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   636
        ^ self stringRepresentation
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   637
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   638
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   639
stringRepresentation
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   640
        "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
   641
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   642
        ^ self printString 
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
9146
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   645
valueWithPossibleArguments:argArray
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   646
     ^ self
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   647
!
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   648
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   649
veryDeepCopy
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
   650
     ^ self deepCopyUsing:(IdentityDictionary new)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   651
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   652
7567
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   653
!Object methodsFor:'Compatibility-VW'!
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   654
8637
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   655
isCharacters
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   656
    "added for visual works compatibility"
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   657
    ^ false
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   658
!
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   659
7567
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   660
keyNotFoundError:aKey
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   661
    "VW compatibility"
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   662
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   663
    self errorKeyNotFound:aKey.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   664
!
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   665
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   666
oneWayBecome:anotherObject
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   667
    ^ self becomeSameAs:anotherObject
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   668
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   669
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   670
     |arr o1 o2|
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   671
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   672
     arr := Array new:2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   673
     arr at:1 put:(o1 := Object new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   674
     arr at:2 put:(o2 := Point new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   675
     o1 oneWayBecome:o2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   676
     (arr at:1) ~~ o2 ifTrue:[self halt].
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   677
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   678
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   679
     |arr o1 o2|
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   680
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   681
     arr := Array new:2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   682
     arr at:1 put:(o1 := Object new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   683
     arr at:2 put:(o2 := Point new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   684
     o1 becomeSameAs:o2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   685
     (arr at:1) ~~ o2 ifTrue:[self halt].
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   686
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   687
! !
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   688
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   689
!Object methodsFor:'accessing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   690
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   691
at:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   692
    "return the indexed instance variable with index, anInteger;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   693
     this method can be redefined in subclasses."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   694
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   695
    ^ self basicAt:index
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   698
at:index put:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   699
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   700
     this method can be redefined in subclasses. Returns anObject (sigh)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   701
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   702
    ^ self basicAt:index put:anObject
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
    "Modified: 19.4.1996 / 11:13:29 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   705
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   706
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   707
basicAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   708
    "return the indexed instance variable with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   709
     Trigger an error if the receiver has no indexed instance variables.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   710
     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
   711
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   712
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   713
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   714
    REGISTER int nbytes, indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   715
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   716
    REGISTER char *pFirst;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   717
    REGISTER int n;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   718
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
     * notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   721
     * this can be done since basicAt: is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   722
     * and SmallInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   723
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   724
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   725
        myClass = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   726
        indx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   727
        n /* nInstVars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   728
        n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   729
        nbytes = __qSize(self) - n /* nInstBytes */;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   730
        pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   731
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   732
        switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   733
            case __MASKSMALLINT(POINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   734
            case __MASKSMALLINT(WKPOINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   735
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   736
                 * pointers
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
                if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   739
                    OBJ *op;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   740
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   741
                    op = (OBJ *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   742
                    RETURN ( *op );
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   745
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   746
            case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   747
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   748
                 * (unsigned) bytes
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
                if ((unsigned)indx < nbytes) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   751
                    unsigned char *cp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   752
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   753
                    cp = (unsigned char *)pFirst + indx;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   754
                    RETURN ( __mkSmallInteger( (*cp & 0xFF)) );
6654
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   757
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   758
            case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   759
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   760
                 * native floats
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
                if ((unsigned)indx < (nbytes / sizeof(float))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   763
                    float *fp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   764
                    float f;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   765
                    OBJ v;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   766
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   767
                    fp = (float *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   768
                    f = *fp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   769
                    if (f == 0.0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   770
                        v = __float0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   771
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   772
                        __qMKSFLOAT(v, f);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   773
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   774
                    RETURN (v);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   775
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   776
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   777
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   778
            case __MASKSMALLINT(DOUBLEARRAY):
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
                 * native doubles
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   781
                 */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   782
#ifdef __NEED_DOUBLE_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   783
                if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   784
                    int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
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
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   787
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   788
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   789
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   790
                if ((unsigned)indx < (nbytes / sizeof(double))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   791
                    double *dp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   792
                    double d;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   793
                    OBJ v;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   794
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   795
                    dp = (double *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   796
                    d = *dp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   797
                    if (d == 0.0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   798
                        v = __float0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   799
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   800
                        __qMKFLOAT(v, d);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   801
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   802
                    RETURN (v);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   803
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   804
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   805
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   806
            case __MASKSMALLINT(WORDARRAY):
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
                 * unsigned 16bit ints
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
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   811
                 * it makes us independent of the short-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   812
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   813
                if ((unsigned)indx < (nbytes>>1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   814
                    unsigned short *sp;
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
                    sp = (unsigned short *)(pFirst + (indx<<1));
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   817
                    RETURN ( __mkSmallInteger( (*sp & 0xFFFF)) );
6654
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   820
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   821
            case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   822
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   823
                 * signed 16bit ints
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
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   826
                 * it makes us independent of the short-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   827
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   828
                if ((unsigned)indx < (nbytes>>1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   829
                    short *ssp;
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
                    ssp = (short *)(pFirst + (indx<<1));
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   832
                    RETURN ( __mkSmallInteger( (*ssp) ));
6654
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   835
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   836
            case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   837
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   838
                 * unsigned 32bit ints
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
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   841
                 * it makes us independent of the int-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   842
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   843
                if ((unsigned)indx < (nbytes>>2)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   844
                    unsigned int32 ul;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   845
                    unsigned int32 *lp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   846
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   847
                    lp = (unsigned int32 *)(pFirst + (indx<<2));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   848
                    ul = *lp;
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8892
diff changeset
   849
#if __POINTER_SIZE__ == 8
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   850
                    {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   851
                        unsigned  INT ull = (unsigned INT)ul;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   852
                        RETURN ( __mkSmallInteger(ull) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   853
                    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   854
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   855
                    if (ul <= _MAX_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   856
                        RETURN ( __mkSmallInteger(ul) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   857
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   858
                    RETURN ( __MKULARGEINT(ul) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   859
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   860
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   861
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   862
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   863
            case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   864
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   865
                 * signed 32bit ints
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
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   868
                 * it makes us independent of the int-size of the machine
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   869
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   870
                if ((unsigned)indx < (nbytes>>2)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   871
                    int32 *slp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   872
                    int32 l;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   873
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   874
                    slp = (int32 *)(pFirst + (indx<<2));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   875
                    l = *slp;
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8892
diff changeset
   876
#if __POINTER_SIZE__ == 8
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   877
                    {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   878
                        INT ll = (INT)l;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   879
                        RETURN ( __mkSmallInteger(ll) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   880
                    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   881
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   882
                    if (__ISVALIDINTEGER(l)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   883
                        RETURN ( __mkSmallInteger(l) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   884
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   885
                    RETURN ( __MKLARGEINT(l) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   886
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   887
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   888
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   889
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   890
            case __MASKSMALLINT(SLONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   891
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   892
                 * signed 64bit longlongs
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   893
                 */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   894
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   895
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   896
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
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
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   899
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   900
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   901
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   902
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   903
                 * 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
   904
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   905
                if ((unsigned)indx < (nbytes>>3)) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8892
diff changeset
   906
#if __POINTER_SIZE__ == 8
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   907
                    INT *slp, ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   908
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   909
                    slp = (INT *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   910
                    ll = *slp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   911
                    if (__ISVALIDINTEGER(ll)) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   912
                        RETURN ( __mkSmallInteger(ll) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   913
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   914
                    RETURN ( __MKLARGEINT(ll) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   915
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   916
                    __int64__ *llp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   917
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   918
                    llp = (__int64__ *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   919
                    RETURN (__MKINT64(llp));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   920
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   921
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   922
                break;
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
            case __MASKSMALLINT(LONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   925
                /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   926
                 * unsigned 64bit longlongs
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   927
                 */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   928
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   929
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   930
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
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
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   933
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   934
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   935
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   936
                /* Notice: the hard coded shifts are by purpose;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   937
                 * 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
   938
                 */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   939
                if ((unsigned)indx < (nbytes>>3)) {
8901
824a89d0b5c7 alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents: 8892
diff changeset
   940
#if __POINTER_SIZE__ == 8
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   941
                    unsigned INT *ulp, ul;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   942
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   943
                    ulp = (unsigned INT *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   944
                    ul = *ulp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   945
                    if (ul <= _MAX_INT) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
   946
                        RETURN ( __mkSmallInteger(ul) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   947
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   948
                    RETURN ( __MKULARGEINT(ul) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   949
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   950
                    __uint64__ *llp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   951
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   952
                    llp = (__uint64__ *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   953
                    RETURN (__MKUINT64(llp));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   954
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   955
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   956
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   957
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   958
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   959
%}.
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
   960
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   961
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   962
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   963
basicAt:index put:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   964
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   965
     Returns anObject (sigh).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   966
     Trigger an error if the receiver has no indexed instance variables.
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
     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
   969
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   970
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   971
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   972
    register int nbytes, indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   973
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   974
    register char *pFirst;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   975
/*    int nInstBytes, ninstvars, flags; */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   976
    REGISTER int n;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   977
    unsigned int u;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   978
    int val;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   979
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   980
    /* notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   981
       this can be done since basicAt: is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   982
       and SmallInteger */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   983
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   984
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   985
        indx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   986
        myClass = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   987
        n /* ninstvars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   988
        n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   989
        nbytes = __qSize(self) - n /* nInstBytes */;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   990
        pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   991
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   992
        switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   993
            case __MASKSMALLINT(POINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   994
            case __MASKSMALLINT(WKPOINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   995
                if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   996
                    OBJ *op;
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
                    op = (OBJ *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
   999
                    *op = anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1000
                    __STORE(self, anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1001
                    RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1002
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1003
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1004
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1005
            case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1006
                if (__isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1007
                    val = __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1008
                    if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1009
                        if ((unsigned)indx < nbytes) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1010
                            char *cp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1011
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1012
                            cp = pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1013
                            *cp = val;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1014
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1015
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1016
                    }
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1019
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1020
            case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1021
                if ((unsigned)indx < (nbytes / sizeof(float))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1022
                    float *fp;
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
                    fp = (float *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1025
                    if (anObject != nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1026
                        if (! __isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1027
                            if (__qIsFloatLike(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1028
                                *fp = (float)(__floatVal(anObject));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1029
                                RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1030
                            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1031
                            if (__qIsShortFloat(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1032
                                *fp = __shortFloatVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1033
                                RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1034
                            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1035
                        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1036
                            *fp = (float) __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1037
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1038
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1039
                    }
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1042
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1043
            case __MASKSMALLINT(DOUBLEARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1044
#ifdef __NEED_DOUBLE_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1045
                if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1046
                    int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1047
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1048
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1049
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1050
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1051
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1052
                if ((unsigned)indx < (nbytes / sizeof(double))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1053
                    double *dp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1054
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1055
                    dp = (double *)pFirst + indx;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1056
                    if (anObject != nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1057
                        if (! __isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1058
                            if (__qIsFloatLike(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1059
                                *dp = __floatVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1060
                                RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1061
                            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1062
                            if (__qIsShortFloat(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1063
                                *dp = (double)__shortFloatVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1064
                                RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1065
                            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1066
                        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1067
                            *dp = (double) __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1068
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1069
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1070
                    }
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1073
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1074
            case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1075
                if (__isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1076
                    val = __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1077
                    if ((unsigned)val <= 0xFFFF) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1078
                        if ((unsigned)indx < (nbytes>>1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1079
                            unsigned short *sp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1080
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1081
                            sp = (unsigned short *)(pFirst + (indx<<1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1082
                            *sp = val;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1083
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1084
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1085
                    }
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1088
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1089
            case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1090
                if (__isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1091
                    val = __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1092
                    if ((val >= -32768) && (val < 32768)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1093
                        if ((unsigned)indx < (nbytes>>1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1094
                            short *ssp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1095
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1096
                            ssp = (short *)(pFirst + (indx<<1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1097
                            *ssp = val;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1098
                            RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1099
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1100
                    }
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
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1103
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1104
            case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1105
                if ((unsigned)indx < (nbytes>>2)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1106
                    int32 *slp;
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
                    slp = (int32 *)(pFirst + (indx<<2));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1109
                    if (__isSmallInteger(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1110
                        *slp = __intVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1111
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1112
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1113
                    n = __signedLongIntVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1114
                    /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1115
                     * zero means failure for an int larger than 4 bytes 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1116
                     * (would be a smallInteger) 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1117
                     */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1118
                    if (n) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1119
                        *slp = n;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1120
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1121
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1122
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1123
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1124
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1125
            case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1126
                if ((unsigned)indx < (nbytes>>2)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1127
                    unsigned int32 *lp;
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
                    lp = (unsigned int32 *)(pFirst + (indx<<2));
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1130
                    if (anObject == __mkSmallInteger(0)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1131
                        *lp = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1132
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1133
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1134
                    u = __longIntVal(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1135
                    /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1136
                     * zero means failure for an int larger than 4 bytes
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1137
                     * (would be a smallInteger)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1138
                     */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1139
                    if (u) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1140
                        *lp = u;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1141
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1142
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1143
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1144
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1145
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1146
            case __MASKSMALLINT(SLONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1147
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1148
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1149
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1150
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1151
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1152
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1153
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1154
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1155
                if ((unsigned)indx < (nbytes>>3)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1156
                    __int64__ ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1157
                    __int64__ *sllp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1158
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1159
                    sllp = (__int64__ *)(pFirst + (indx<<3));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1160
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1161
                    if (anObject == __mkSmallInteger(0)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1162
                        ll.lo = ll.hi = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1163
                        *sllp = ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1164
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1165
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1166
                    if (__signedLong64IntVal(anObject, &ll)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1167
                        *sllp = ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1168
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1169
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1170
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1171
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1172
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1173
            case __MASKSMALLINT(LONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1174
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1175
                if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1176
                    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1177
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1178
                    pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1179
                    nbytes -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1180
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1181
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1182
                if ((unsigned)indx < (nbytes>>3)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1183
                    __uint64__ ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1184
                    __uint64__ *llp;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1185
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1186
                    llp = (__uint64__ *)(pFirst + (indx<<3));
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1187
                    if (anObject == __mkSmallInteger(0)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1188
                        ll.lo = ll.hi = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1189
                        *llp = ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1190
                        RETURN ( anObject );
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
                    if (__unsignedLong64IntVal(anObject, &ll)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1193
                        *llp = ll;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1194
                        RETURN ( anObject );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1195
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1196
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1197
                break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1198
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1199
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1200
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1201
    index isInteger ifFalse:[
6654
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
         the index should be an integer number
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1204
        "
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  1205
        ^ self indexNotInteger:index
5755
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 between:1 and:self size) 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 is less than 1 or greater than the size of the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1210
         receiver collection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1211
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1212
        ^ self subscriptBoundsError:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1213
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1214
    (self class isFloatsOrDoubles) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1215
        anObject isNumber ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1216
            ^ self basicAt:index put:(anObject asFloat)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1217
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1218
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1219
    anObject isInteger ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1220
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1221
         the object to put into the receiver collection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1222
         should be an integer number
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1223
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1224
        ^ self elementNotInteger
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1225
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1226
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1227
     the object to put into the receiver collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1228
     is not an instance of the expected element class,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1229
     or the value is  not within the elements valid range.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1230
    "
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  1231
    ^ self elementBoundsError:anObject
5755
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
    "Modified: 19.4.1996 / 11:14:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1234
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1235
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1236
byteAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1237
    "return the byte at index. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1238
     This is only allowed for non-pointer indexed objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1239
     (i.e. byteArrays, wordArrays, floatArrays etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1240
     The receivers indexed instvars are treated as an uninterpreted
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1241
     collection of bytes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1242
     Only useful with binary storage."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1243
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1244
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1245
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1246
    REGISTER int indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1247
    int nIndex;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1248
    REGISTER OBJ slf;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1249
    REGISTER OBJ cls;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1250
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1251
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1252
        slf = self;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1253
        if (__isNonNilObject(slf)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1254
            unsigned char *pFirst;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1255
            int nIndex;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1256
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1257
            cls = __qClass(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1258
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1259
            pFirst = __byteArrayVal(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1260
            pFirst += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1261
            nIndex = __byteArraySize(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1262
            indx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1263
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1264
            switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1265
                case __MASKSMALLINT(DOUBLEARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1266
#ifdef __NEED_DOUBLE_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1267
                    if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1268
                        int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-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
                        pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1271
                        nIndex -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1272
                    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1273
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1274
                    /* fall into */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1275
                case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1276
                case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1277
                case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1278
                case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1279
                case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1280
                case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1281
                    if ((unsigned)indx < (unsigned)nIndex) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1282
                        RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1283
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1284
                    break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1285
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1286
                case __MASKSMALLINT(LONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1287
                case __MASKSMALLINT(SLONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1288
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1289
                    if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1290
                        int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
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
                        pFirst += delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1293
                        nIndex -= delta;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1294
                    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1295
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1296
                    if ((unsigned)indx < (unsigned)nIndex) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  1297
                        RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1298
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1299
                    break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1300
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1301
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1302
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1303
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1304
    "/ index not integer or index out of range
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1305
    "/ or non-byte indexable receiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1306
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1307
    ^ self primitiveFailed
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
     Point new byteAt:1
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1311
     (ByteArray with:1 with:2) byteAt:2
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1312
     (WordArray with:1) byteAt:1       
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1313
     (FloatArray with:1.0) byteAt:2 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1314
     'hello' byteAt:1               
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1317
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1318
byteAt:index put:byteValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1319
    "set the byte at index. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1320
     This is only allowed for non-pointer indexed objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1321
     (i.e. byteArrays, wordArrays, floatArrays etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1322
     The receivers indexed instvars are treated as an uninterpreted
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1323
     collection of bytes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1324
     Only useful with binary storage."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1325
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1326
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1327
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1328
    REGISTER int indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1329
    int val, nIndex;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1330
    REGISTER OBJ slf;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1331
    REGISTER OBJ cls;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1332
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1333
    if (__bothSmallInteger(index, byteValue)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1334
        val = __intVal(byteValue);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1335
        if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1336
            slf = self;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1337
            if (__isNonNilObject(slf)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1338
                cls = __qClass(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1339
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1340
                indx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1341
                switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1342
                    case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1343
                    case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1344
                    case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1345
                    case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1346
                    case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1347
                    case __MASKSMALLINT(LONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1348
                    case __MASKSMALLINT(SLONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1349
                    case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1350
                    case __MASKSMALLINT(DOUBLEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1351
                        indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1352
                        nIndex = __byteArraySize(slf);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1353
                        if ((unsigned)indx < (unsigned)nIndex) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1354
                            __ByteArrayInstPtr(slf)->ba_element[indx] = val;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1355
                            RETURN ( byteValue );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1356
                        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1357
                        break;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1358
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1359
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1360
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1361
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1362
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1363
    "/ index not integer or index out of range
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1364
    "/ or non-byte indexable receiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1365
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1366
    ^ self primitiveFailed
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
     (ByteArray with:1 with:2) byteAt:2 put:3; yourself
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1370
     'hello' copy byteAt:1 put:105; yourself              
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
!
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
instVarAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1375
    "return a non-indexed instance variable;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1376
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1377
     - use with care (needed for copy, inspector etc.)"
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
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1380
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1381
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1382
    int idx, ninstvars;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1383
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1384
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1385
        myClass = __Class(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1386
        idx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1387
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1388
         * do not allow returning of non-object fields.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1389
         * if subclass did not make privisions for that,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1390
         * we wont do so here ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1391
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1392
        if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1393
            if (idx == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1394
                RETURN ( nil )
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1395
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1396
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1397
        ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1398
        if ((idx >= 0) && (idx < ninstvars)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1399
            RETURN ( __InstPtr(self)->i_instvars[idx] );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1400
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1401
    }
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1402
%}.
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1403
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1404
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1405
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1406
instVarAt:index put:value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1407
    "change a non-indexed instance variable;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1408
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1409
     - use with care (needed for copy, inspector etc.)"
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
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1412
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1413
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1414
    int idx, ninstvars;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1415
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1416
    if (__isSmallInteger(index)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1417
        myClass = __Class(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1418
        idx = __intVal(index) - 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1419
        ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1420
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1421
         * do not allow setting of non-object fields.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1422
         * if subclass did not make privisions for that,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1423
         * we wont do so here ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1424
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1425
        if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1426
            if (idx == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1427
                RETURN ( nil )
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1428
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1429
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1430
        if ((idx >= 0) && (idx < ninstvars)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1431
            __InstPtr(self)->i_instvars[idx] = value;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1432
            __STORE(self, value);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1433
            RETURN ( value );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1434
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1435
    }
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1436
%}.
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1437
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1438
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1439
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1440
instVarNamed:name 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1441
    "return a non-indexed instance variables value by name;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1442
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1443
     - 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
  1444
     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
  1445
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1446
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1447
    ^ self instVarAt:(self class instVarOffsetOf:name)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1448
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1449
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1450
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1451
     |p|
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
     p := Point x:10 y:20.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1454
     p instVarNamed:'x'  
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
    "Modified: 19.4.1996 / 11:12:39 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1460
instVarNamed:name ifAbsent:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1461
    "return a non-indexed instance variables value by name,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1462
     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
  1463
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1464
     - 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
  1465
     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
  1466
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1467
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1468
    |idx|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1469
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1470
    idx := self class instVarOffsetOf:name.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1471
    idx isNil ifTrue:[^ exceptionBlock value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1472
    ^ self instVarAt:idx
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
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
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1477
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1478
     p := Point x:10 y:20.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1479
     p instVarNamed:'x'  
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
    "Created: 6.7.1996 / 23:02:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1483
    "Modified: 6.7.1996 / 23:03:41 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1484
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1485
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1486
instVarNamed:name put:value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1487
    "set a non-indexed instance variable by name;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1488
     peeking into an object this way is not very object oriented 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1489
     - if at all, use with care (provided for protocol completeness).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1490
     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
  1491
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1492
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1493
    ^ self instVarAt:(self class instVarOffsetOf:name) put:value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1494
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1495
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1496
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1497
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1498
     p := Point x:10 y:20.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1499
     p instVarNamed:'x' put:30.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1500
     p  
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1503
    "Modified: 19.4.1996 / 11:12:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1504
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1505
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1506
!Object methodsFor:'attributes access'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1507
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1508
objectAttributeAt:attributeKey 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1509
    "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
  1510
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1511
    | attrs |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1512
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1513
    attrs := self objectAttributes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1514
    (attrs notNil and:[attrs size > 0]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1515
        ^ attrs at:attributeKey ifAbsent:[]
5755
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
    ^ nil
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
    "Created: / 22.1.1998 / 21:29:17 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1520
    "Modified: / 3.2.1998 / 18:55:55 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1521
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1522
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1523
objectAttributeAt:attributeKey put:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1524
    "store the attribute anObject referenced by key into the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1525
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1526
    "/ must do this save from interrupts, since the attributes collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1527
    "/ is possibly accessed from multiple threads ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1528
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1529
        | attrs |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1530
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1531
        attrs := self objectAttributes.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1532
        (attrs isNil or:[attrs size == 0]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1533
            attrs := WeakIdentityDictionary new.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1534
            attrs at:attributeKey put:anObject.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1535
            self objectAttributes:attrs.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1536
        ] ifFalse:[ 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1537
            attrs at:attributeKey put:anObject.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1538
        ].
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1539
    ] valueUninterruptably
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1540
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1541
    "Attaching additional attributes (slots) to an arbitrary object:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1542
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1543
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1544
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1545
     p := Point new.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1546
     p objectAttributeAt:#color put:#green.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1547
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1548
     p objectAttributeAt:#color
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1549
    "
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
    "Created: / 22.1.1998 / 21:29:25 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1552
    "Modified: / 3.2.1998 / 18:57:58 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1555
objectAttributes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1556
    "return a Collection of attributes - nil if there is none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1557
     The default implementation here uses a global WeakDictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1558
     attributes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1559
     This may be too slow for high frequency slot access,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1560
     therefore, some classes may redefine this for better performance.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1561
     Notice the mentioning of a WeakDictionary - read the classes documentation."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1562
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1563
    ^ ObjectAttributes at:self ifAbsent:[nil]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1564
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1565
    "Created: / 22.1.1998 / 21:29:30 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1566
    "Modified: / 18.2.2000 / 11:34:16 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1567
!
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:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1570
    "set the collection of attributes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1571
     The default implementation here uses a global Dictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1572
     attributes which may be too slow for high frequency change&update.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1573
     Therefore, some classes may redefine this for better performance."
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
    "/ must do this save from interrupts, since the attributes collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1576
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1577
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1578
    (OperatingSystem blockInterrupts) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1579
        "/ the common case - already blocked
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1580
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1581
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1582
            ObjectAttributes removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1583
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1584
            ObjectAttributes at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1585
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1586
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1587
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1588
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1589
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1590
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1591
            ObjectAttributes removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1592
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1593
            ObjectAttributes at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1594
        ].
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  1595
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1596
        OperatingSystem unblockInterrupts
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1597
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1598
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1599
    "Created: / 22.1.1998 / 21:29:35 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1600
    "Modified: / 3.2.1998 / 18:58:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1601
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1602
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1603
removeObjectAttribute:attributeKey
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1604
    "make the argument, anObject be no attribute of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1605
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1606
    "/ must do this save from interrupts, since the attributes collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1607
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1608
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1609
        |attrs n a|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1610
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1611
        attrs := self objectAttributes.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1612
        attrs size == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1613
            self objectAttributes:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1614
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1615
            attrs removeKey:attributeKey ifAbsent:nil.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1616
            attrs size == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1617
                self objectAttributes:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1618
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1619
        ]
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1620
    ] valueUninterruptably
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1621
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1622
    "Created: / 22.1.1998 / 21:29:39 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1623
    "Modified: / 18.2.2000 / 11:32:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1624
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1625
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1626
!Object methodsFor:'binary storage'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1627
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  1628
binaryStoreBytes
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  1629
    ^ ByteArray streamContents:[:s | self storeBinaryOn:s].
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  1630
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  1631
    "
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  1632
     #('hello' 1 1.234) binaryStoreBytes
8409
5c6578c5d003 comment
Claus Gittinger <cg@exept.de>
parents: 8404
diff changeset
  1633
     'hello' asUnicode16String binaryStoreBytes
5c6578c5d003 comment
Claus Gittinger <cg@exept.de>
parents: 8404
diff changeset
  1634
5c6578c5d003 comment
Claus Gittinger <cg@exept.de>
parents: 8404
diff changeset
  1635
     Object fromBinaryStoreBytes:
5c6578c5d003 comment
Claus Gittinger <cg@exept.de>
parents: 8404
diff changeset
  1636
        ('hello' asUnicode16String binaryStoreBytes)
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  1637
    "
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  1638
!
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  1639
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1640
hasSpecialBinaryRepresentation
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1641
    "return true, if the receiver has a special binary representation;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1642
     default here is false, but can be redefined in class which provide
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1643
     their own storeBinary/readBinary methods.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1644
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1645
     Normal user classes should not use this, it is meant as a hook for
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1646
     special classes such as True, False, UndefinedObject or SmallInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1647
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1648
     If your instances should be stored in a special way, see
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1649
     #representBinaryOn: and #readBinaryContentsFromdata:manager:."
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
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1652
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1653
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1654
readBinaryContentsFrom:stream manager:manager
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1655
    "reconstruct the receivers instance variables by reading a binary
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1656
     binary representation from stream. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1657
     This is a general implementation, walking over instances 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1658
     and loading each recursively using manager.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1659
     Redefined by some classes to read a more compact representations
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1660
     (see String, SmallInteger etc).
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
     Notice, that the object is already recreated as an empty corps
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1663
     with instance variables all nil and bit-instances (bytes, words etc.) 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1664
     already read and restored.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1665
8546
7fd1cb9aa20e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8542
diff changeset
  1666
     Also notice: this method is not called, if a private representation
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1667
     has been stored (see representBinaryOn:). 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1668
     In that case, #readBinaryContentsFromData:manager: is called, which
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1669
     has to be reimplemented in the objects class."
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
    |size "{ Class: SmallInteger }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1672
     instvarArray|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1673
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1674
    stream next == 1 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1675
        "/
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1676
        "/ special representation ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1677
        "/
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1678
        instvarArray := Array new:(size := stream nextNumber:3).
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1679
        1 to:size do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1680
            instvarArray basicAt:i put:(manager nextObject)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1681
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1682
        self readBinaryContentsFromData:instvarArray manager:manager.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1683
        ^ self
5755
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
    "/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1687
    "/ standard representation
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1688
    "/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1689
    size := self basicSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1690
    size ~~ 0 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1691
        self class isPointers ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1692
            1 to:size do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1693
                self basicAt:i put:(manager nextObject)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1694
            ]
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
    size := self class instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1698
    1 to:size do:[:i |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1699
        self instVarAt:i put:(manager nextObject)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1700
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1701
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1702
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1703
readBinaryContentsFromData:instvarArray manager:manager
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1704
    "reconstruct the receivers instance variables by filling instance
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1705
     variables with values from instvarArray. This array contains the instvars
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1706
     as specified in #representBinaryOn: when the object was stored.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1707
     It is the receivers responsibility to set its instance variables in the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1708
     same order from that array."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1709
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  1710
    ^ self subclassResponsibility:'method must be reimplemented in subclass for binary storage'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1711
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1712
    "typical implementation (see also comment in #representBinaryOn:)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1713
     (for an object with foo, bar and baz as instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1714
      which did not store baz and wants baz to be reinitialized to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1715
      some constant string)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1716
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1717
        foo := instvarArray at:1.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1718
        bar := instvarArray at:2.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1719
        baz := 'aConstant'.
5755
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1722
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1723
representBinaryOn:manager
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1724
    "this method is called by the storage manager to ask objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1725
     if they wish to provide their own binary representation.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1726
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1727
     If they want to do so, they should return an array containing all
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1728
     instance variables (named & indexed pointer) to be stored. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1729
     If not redefined, this method returns nil which means that all 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1730
     instance variables are to be stored.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1731
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1732
     It should be redefined in objects which do not want all instance variables
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1733
     to be stored (for example: objects which keep references to a view etc.).
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
     If this is redefined returning non-nil, the corresponding class needs
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1736
     a redefined instance method named #readBinaryContentsFromData:manager:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1737
     which has to fill the receivers named (and optionally indexed pointer)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1738
     instance variables with corresponding values from a data array."
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
    ^ nil
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
    "typical implementation:  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1743
     (see also comment in #readBinaryContentsFromData:manager:)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1744
     for an object with foo, bar and baz as instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1745
     which does not want to store baz:
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
     representBinaryOn:manager
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1748
        |data|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1749
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1750
        data := Array new:2.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1751
        data at:1 put:foo.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1752
        data at:2 put:bar.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1753
        ^ data
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1754
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1755
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1756
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1757
storeBinaryDefinitionBodyOn:stream manager:manager
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1758
    "append a binary representation of the receivers body onto stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1759
     This is a general implementation walking over instances storing
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1760
     each recursively as an ID using manager.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1761
     Can be redefined in subclasses."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1762
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1763
    |basicSize    "{ Class: SmallInteger }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1764
     instSize     "{ Class: SmallInteger }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1765
     specialSize  "{ Class: SmallInteger }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1766
     myClass specialRep pointers|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1767
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1768
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1769
    instSize := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1770
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1771
    (pointers := myClass isPointers) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1772
        "/
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1773
        "/ inst size not needed - if you uncomment the line below,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1774
        "/ also uncomment the corresponding line in
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1775
        "/ Object>>binaryDefinitionFrom:manager:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1776
        "/
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1777
        "/ stream nextPut:instSize. "mhmh this limits us to 255 named instvars"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1778
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1779
        myClass isVariable ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1780
            stream nextNumber:3 put:(basicSize := self basicSize)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1781
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1782
            basicSize := 0
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1783
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1784
    ] ifFalse: [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1785
        stream nextNumber:4 put:(basicSize := self basicSize).
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1786
        myClass isBytes ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1787
            1 to:basicSize do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1788
                stream nextPut:(self basicAt:i)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1789
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1790
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1791
            myClass isWords ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1792
                1 to:basicSize do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1793
                    stream nextNumber:2 put:(self basicAt: i)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1794
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1795
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1796
                myClass isLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1797
                    1 to:basicSize do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1798
                        stream nextNumber:4 put:(self basicAt: i)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1799
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1800
                ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1801
                    myClass isFloats ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1802
                        "could do it in one big write on machines which use IEEE floats ..."
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1803
                        1 to:basicSize do:[:i |
7359
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  1804
                            ShortFloat storeBinaryIEEESingle:(self basicAt:i) on:stream
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1805
                        ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1806
                    ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1807
                        myClass isDoubles ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1808
                            "could do it in one big write on machines which use IEEE doubles ..."
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1809
                            1 to:basicSize do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1810
                                Float storeBinaryIEEEDouble:(self basicAt:i) on:stream
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1811
                            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1812
                        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1813
                            "/ should never be reached ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1814
                            1 to:basicSize do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1815
                                manager putIdOf:(self basicAt:i) on:stream
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1816
                            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1817
                        ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1818
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1819
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1820
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1821
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1822
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1823
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1824
    (pointers or:[instSize ~~ 0]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1825
        specialRep := self representBinaryOn:manager.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1826
        specialRep notNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1827
            specialSize := specialRep basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1828
            stream nextPut:1.     "/ means: private representation follows
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1829
            stream nextNumber:3 put:specialSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1830
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1831
            1 to:specialSize do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1832
                manager putIdOf:(specialRep at:i) on:stream
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1833
            ].
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
            stream nextPut:0.     "/ means: normal representation follows
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1836
                                  "/ index pointers followed by named instanceVars
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1837
            pointers ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1838
                basicSize ~~ 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1839
                    1 to:basicSize do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1840
                        manager putIdOf:(self basicAt:i) on:stream
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1841
                    ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1842
                ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1843
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1844
            instSize ~~ 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1845
                1 to:instSize do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1846
                    manager putIdOf:(self instVarAt:i) on:stream
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1847
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1848
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1849
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1850
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1851
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1852
    "Modified: / 2.11.1997 / 14:43:29 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1853
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1854
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1855
storeBinaryDefinitionOn:stream manager:manager
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1856
    "append a binary representation of the receiver onto stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1857
     This is an internal interface for binary storage mechanism.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1858
     This method first stores the class, then the body, which is done
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1859
     in a separate method to allow redefinition of the bodies format.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1860
     Can be redefined in subclasses to write more compact representations
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1861
     (see String, SmallInteger etc)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1862
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1863
    manager putIdOfClass:(self class) on:stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1864
    self storeBinaryDefinitionBodyOn:stream manager:manager
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
    "Modified: 23.4.1996 / 09:31:12 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1867
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1868
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1869
storeBinaryOn:aStreamOrFilename
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1870
    "Writes a description of the receiver onto aStreamOrFilename, in a way that allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1871
     the object's structure to be reconstructed from the stream's contents"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1872
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1873
    BinaryOutputManager store:self on:aStreamOrFilename
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1874
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1875
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1876
     |a s1 s2|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1877
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1878
     s1 := 'hello'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1879
     s2 := 'world'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1880
     a := Array new:5.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1881
     a at:1 put:s1.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1882
     a at:2 put:s2.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1883
     a at:3 put:s1.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1884
     a at:4 put:s2.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1885
     a storeBinaryOn:'test.boss'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1886
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1887
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1888
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1889
     (BinaryObjectStorage onOld:'test.boss' asFilename readStream)
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1890
        next
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1891
            inspect
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1892
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1893
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1894
    "Modified: / 1.11.1997 / 21:16:24 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1895
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1896
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1897
storeBinaryOn:stream manager:manager
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1898
    "append a binary representation of the receiver onto stream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1899
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1900
    manager putIdOf:self on:stream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1901
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1902
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1903
!Object methodsFor:'change & update'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1904
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1905
broadcast:aSelectorSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1906
    "send a message with selector aSelectorSymbol to all my dependents"
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
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1909
        dependent perform:aSelectorSymbol
5755
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1912
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1913
broadcast:aSelectorSymbol with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1914
    "send a message with selector aSelectorSymbol with an additional
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1915
     argument anArgument to all my dependents."
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
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1918
        dependent perform:aSelectorSymbol with:anArgument
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1919
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1920
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1921
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1922
changeRequest
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1923
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1924
     grant the request, and return true if so"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1925
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1926
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1927
        dependent updateRequest ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1928
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1929
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1930
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1931
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1932
changeRequest:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1933
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1934
     grant the request, and return true if so"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1935
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1936
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1937
        (dependent updateRequest:aParameter) ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1938
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1939
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1940
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1941
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1942
changeRequest:aParameter from:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1943
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1944
     except anObject grant the request, and return true if so.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1945
     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
  1946
     about to send the change request."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1947
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1948
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1949
        dependent == anObject ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1950
            (dependent updateRequest:aParameter) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1951
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1952
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1953
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1954
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1955
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1956
changeRequestFrom:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1957
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1958
     except anObject grant the request, and return true if so.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1959
     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
  1960
     about to send the change request."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1961
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1962
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1963
        dependent == anObject ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1964
            (dependent updateRequest) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1965
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1966
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1967
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1968
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1969
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1970
changed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1971
    "notify all dependents that the receiver has changed.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1972
     Each dependent gets a '#update:'-message with the original
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1973
     receiver as argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1974
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1975
    self changed:nil
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
changed:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1979
    "notify all dependents that the receiver has changed somehow.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1980
     Each dependent gets a '#update:'-message with aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1981
     as argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1982
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1983
    self changed:aParameter with:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1984
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1985
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1986
changed:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1987
    "notify all dependents that the receiver has changed somehow.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1988
     Each dependent gets a  '#update:with:from:'-message, with aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1989
     and anArgument as arguments."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1990
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1991
    self dependentsDo:[:dependent | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  1992
        dependent update:aParameter with:anArgument from:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1993
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1994
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1995
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1996
update:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1997
    "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
  1998
     on whom the receiver depends, has changed. The argument aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1999
     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
  2000
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2001
     Default behavior here is to do nothing"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2002
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2003
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2004
!
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
update:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2007
    "dependent is notified of some change -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2008
     Default is to try update:"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2009
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2010
    ^ self update:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2011
!
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
update:aParameter with:anArgument from:sender
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2014
    "dependent is notified of some change -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2015
     Default is to try update:with:"
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
    ^ self update:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2018
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2019
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2020
updateRequest
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2021
    "return true, if an update request is granted.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2022
     Default here is to grant updates - may be used
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2023
     to lock updates if someone is making other changes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2024
     from within an update. Or if someone has locked its
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2025
     state and does not want others to change things.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2026
     However, these dependents must all honor the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2027
     changeRequest - ifTrue - change protocol. I.e. they
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2028
     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
  2029
     it returns true. The others must decide in updateRequest and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2030
     return true if they think a change is ok."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2031
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2032
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2033
!
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
updateRequest:aSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2036
    "return true, if an update request is granted.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2037
     Default here a simple updateRequest"
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
    ^ self updateRequest
7177
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2040
!
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2041
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2042
withoutUpdating:someone do:aBlock
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2043
    "evaluate a block but remove someone from my dependents temporarily"
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2044
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2045
    (self dependents includesIdentical:someone)
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2046
    ifFalse:[
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2047
        ^ aBlock value.
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2048
    ].
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2049
    self removeDependent:someone.
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2050
    ^ aBlock ensure:[ self addDependent:someone ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2051
! !
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
!Object methodsFor:'cleanup'!
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
lowSpaceCleanup
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2056
    "ignored here - redefined in some classes to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2057
     cleanup in low-memory situations"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2058
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2059
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2060
! !
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
!Object methodsFor:'comparing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2063
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2064
= anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2065
    "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
  2066
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2067
        This method is partially open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2068
        identical objects are always considered equal.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2069
        redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2070
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2071
    ^ self == anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2072
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2073
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2074
== anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2075
    "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
  2076
     Never redefine this in any class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2077
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2078
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2079
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2080
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2081
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2082
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2083
    RETURN ( (self == anObject) ? true : false );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2084
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2085
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2086
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2087
deepSameContentsAs:anObject
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2088
    "return true, if the receiver and the arg have the same contents
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2089
     in both the named instance vars and any indexed instVars.
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2090
     This method descends into referenced objects, where #sameContentsAs: does not descend"
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2091
5821
c11bb6c8cc8f Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5814
diff changeset
  2092
    |myClass val
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2093
     sz "{ Class: SmallInteger }" |
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2094
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2095
    myClass := self class.
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2096
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2097
        sz := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2098
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2099
        "compare the indexed variables"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2100
        1 to:sz do:[:i |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2101
            val := self basicAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2102
            val isLiteral ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2103
                val = (anObject basicAt:i) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2104
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2105
                (val deepSameContentsAs:(anObject basicAt:i)) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2106
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2107
        ]
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2108
    ].
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2109
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2110
    "compare the instance variables"
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2111
    sz := myClass instSize.
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2112
    1 to:sz do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2113
        val := self instVarAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2114
        val isLiteral ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2115
            val = (anObject instVarAt:i) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2116
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2117
            (val deepSameContentsAs:(anObject instVarAt:i)) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2118
        ]
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2119
    ].
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2120
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2121
    ^ true
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2122
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2123
    "
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2124
     #(1 2 3 4) deepSameContentsAs:#[1 2 3 4] asArray 
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2125
     (1@2) deepSameContentsAs:(1->2)
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2126
    "
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2127
!
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2128
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2129
hash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2130
    "return an Integer useful as a hash key for the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2131
     This hash should return same values for objects with same
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2132
     contents (i.e. use this to hash on structure)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2133
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2134
    ^ self identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2135
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2136
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2137
identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2138
    "return an Integer useful as a hash key for the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2139
     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
  2140
     this to hash on identity of objects).
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
     We cannot use the Objects address (as other smalltalks do) since
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2143
     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
  2144
     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
  2145
     Id in the object header itself as its hashed upon.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2146
     (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
  2147
     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
  2148
     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
  2149
     hashed-upon objects could add an instvar containing the hash value."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2150
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2151
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2152
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  2153
    REGISTER unsigned INT hash;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2154
    static unsigned nextHash = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2155
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2156
    if (__isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2157
        hash = __GET_HASH(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2158
        if (hash == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2159
            /* has no hash yet */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2160
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2161
            if (++nextHash > __MAX_HASH__) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2162
                nextHash = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2163
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2164
            hash = nextHash;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2165
            __SET_HASH(self, hash);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2166
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2167
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2168
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2169
         * now, we got 11 bits for hashing;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2170
         * 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
  2171
         * 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
  2172
         * better distribution (i.e. bigger empty spaces) in hashed collection.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2173
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2174
        hash = __MAKE_HASH__(hash);
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  2175
        RETURN ( __mkSmallInteger(hash) );
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
    ^ 0 "never reached, since redefined in UndefinedObject and SmallInteger"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2181
identityHashForBinaryStore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2182
    "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
  2183
     and does not #become something else, while the hash is used.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2184
     This is only used by the binary storage mechanism, during the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2185
     object writing phase."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2186
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2187
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2188
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  2189
    REGISTER unsigned INT hash, hash1, hash2, sz;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2190
    OBJ o;
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  2191
    static unsigned INT nextHash = 0;
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  2192
    static unsigned INT nextClassHash = 0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2193
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2194
    if (__isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2195
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2196
         * my own identityHash
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2197
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2198
        hash1 = __GET_HASH(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2199
        if (hash1 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2200
            /* has no hash yet */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2201
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2202
            if (++nextHash > __MAX_HASH__) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2203
                nextHash = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2204
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2205
            hash1 = nextHash;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2206
            __SET_HASH(self, hash1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2207
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2208
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2209
         * my classes identityHash
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2210
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2211
        o = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2212
        hash2 = __GET_HASH(o);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2213
        if (hash2 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2214
            /* has no hash yet */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2215
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2216
            if (++nextClassHash > __MAX_HASH__) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2217
                nextClassHash = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2218
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2219
            hash2 = nextClassHash;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2220
            __SET_HASH(o, hash2);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2221
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2222
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2223
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2224
         * some bits of my size
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2225
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2226
        sz = __qSize(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2227
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2228
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2229
         * now, we got 11 + 11 + 8 bits for hashing;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2230
         * 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
  2231
         * 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
  2232
         * better distribution (i.e. bigger empty spaces) in hashed collection.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2233
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2234
        hash = (hash1 << 11) | hash2;           /* 22 bits */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2235
        hash = (hash << 8) | (sz & 0xFC);       /* 30 bits */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2236
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2237
        while ((hash & 0x20000000) == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2238
            hash <<= 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2239
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2240
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  2241
        RETURN ( __mkSmallInteger(hash) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2242
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2243
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2244
    "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
  2245
    ^ self identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2246
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2247
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2248
sameContentsAs:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2249
    "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
  2250
     in both the named instance vars and any indexed instVars.
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2251
     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
  2252
     present in the arg, not vice versa.
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2253
     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
  2254
5821
c11bb6c8cc8f Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5814
diff changeset
  2255
    |myClass
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2256
     sz "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2257
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2258
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2259
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2260
        sz := self basicSize.
7121
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2261
        anObject basicSize >= sz ifFalse:[^ false].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2262
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2263
        "compare the indexed variables"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2264
        1 to:sz do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2265
            (self basicAt:i) == (anObject basicAt:i) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2266
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2267
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2268
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2269
    "compare the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2270
    sz := myClass instSize.
7121
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2271
    anObject instSize >= sz ifFalse:[^ false].
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2272
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2273
    1 to:sz do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2274
        (self instVarAt:i) == (anObject instVarAt:i) ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2275
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2276
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2277
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2278
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2279
    "
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2280
     #(1 2 3 4) sameContentsAs:#[1 2 3 4] asArray 
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2281
     (1@2) sameContentsAs:(1->2)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2282
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2283
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2284
    "Created: / 21.4.1998 / 15:56:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2285
    "Modified: / 21.4.1998 / 15:58:15 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2286
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2287
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2288
~= anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2289
    "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
  2290
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2291
        This method is partially open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2292
        identical objects are never considered unequal.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2293
        redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2294
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2295
    ^ (self = anObject) not
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2296
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2297
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2298
~~ anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2299
    "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
  2300
     Never redefine this in any class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2301
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2302
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2303
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2304
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2305
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2306
    RETURN ( (self == anObject) ? false : true );
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
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2309
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2310
!Object methodsFor:'converting'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2311
6696
36eaa6c17e2c use excla for conses (looks better);
Claus Gittinger <cg@exept.de>
parents: 6656
diff changeset
  2312
!! anObject
6652
4cfba8cb0652 typo and undo renaming of #/#cons:
Stefan Vogel <sv@exept.de>
parents: 6647
diff changeset
  2313
    "return a cons with the receiver as car and the argument as cdr"
4cfba8cb0652 typo and undo renaming of #/#cons:
Stefan Vogel <sv@exept.de>
parents: 6647
diff changeset
  2314
4cfba8cb0652 typo and undo renaming of #/#cons:
Stefan Vogel <sv@exept.de>
parents: 6647
diff changeset
  2315
    ^ Cons car:self cdr:anObject
6697
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
  2316
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
  2317
    "
6698
be8668e8a87e comment
Claus Gittinger <cg@exept.de>
parents: 6697
diff changeset
  2318
     (1 !! 2)                
be8668e8a87e comment
Claus Gittinger <cg@exept.de>
parents: 6697
diff changeset
  2319
     (#car !! #cdr)          
be8668e8a87e comment
Claus Gittinger <cg@exept.de>
parents: 6697
diff changeset
  2320
     (1 !! (2 !! (3 !! nil)))    
be8668e8a87e comment
Claus Gittinger <cg@exept.de>
parents: 6697
diff changeset
  2321
     (1 !! 2) !! (2 !! 3)    
6697
326f50b595f6 comment
Claus Gittinger <cg@exept.de>
parents: 6696
diff changeset
  2322
    "
6652
4cfba8cb0652 typo and undo renaming of #/#cons:
Stefan Vogel <sv@exept.de>
parents: 6647
diff changeset
  2323
!
4cfba8cb0652 typo and undo renaming of #/#cons:
Stefan Vogel <sv@exept.de>
parents: 6647
diff changeset
  2324
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2325
-> anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2326
    "return an association with the receiver as key and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2327
     the argument as value"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2328
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2329
    ^ Association key:self value:anObject
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2332
asCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2333
    "return myself as a Collection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2334
     Redefined in collection to return themself."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2335
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2336
    ^ Array with:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2337
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2338
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2339
asSequenceableCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2340
    "return myself as a SequenceableCollection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2341
     Redefined in SequenceableCollection"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2342
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2343
    ^ Array with:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2344
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2345
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2346
asValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2347
    "return a valueHolder for for the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2348
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2349
    ^ ValueHolder with:self
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2350
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2351
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2352
collect
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2353
    "return mySelf"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2354
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2355
    ^ self
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2356
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2357
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2358
deepCollect
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2359
    "return mySelf"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2360
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2361
    ^ self
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2362
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2363
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2364
deepSelect
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2365
    "return mySelf"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2366
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2367
    ^ self
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2368
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2369
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2370
select
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2371
    "return mySelf"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2372
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2373
    ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2374
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2375
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2376
!Object methodsFor:'copying'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2377
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2378
cloneFrom:anObject 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2379
    "Helper for copy:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2380
     copy all instance variables from anObject into the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2381
     which should be of the same class as the argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2382
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2383
    self cloneFrom:anObject performing:#yourself
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2384
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
     |x|
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
     x := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2389
     x cloneFrom:#(1 2 3).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2390
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2391
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2392
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2393
cloneFrom:anObject performing:aSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2394
    "Helper for copy:
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2395
     for each instance variable from anObject, send it aSymbol
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2396
     and store the result into the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2397
     which should be of the same class as the argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2398
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2399
    |myClass sz "{ Class: SmallInteger }" t |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2400
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2401
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2402
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2403
        sz := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2404
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2405
        "process the indexed instance variables"
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2406
        1 to:sz do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2407
            t := anObject basicAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2408
            aSymbol ~~ #yourself ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2409
                t := t perform:aSymbol.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2410
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2411
            self basicAt:i put:t.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2412
        ]
5755
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
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2415
    "process the named instance variables"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2416
    sz := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2417
    1 to:sz do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2418
        t := anObject instVarAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2419
        aSymbol ~~ #yourself ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2420
            t := t perform:aSymbol
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2421
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2422
        self instVarAt:i put:t
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2423
    ].
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
cloneInstanceVariablesFrom:aPrototype
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2429
    "Shallow copy variables from a prototype into myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2430
     This copies instVars by name - i.e. same-named variables are
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2431
     copied, others are not.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2432
     The variable slots are copied as available 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2433
     (i.e. the min of both indexed sizes is used)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2434
        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2435
    |myInfo otherInfo|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2436
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2437
    myInfo := self class instanceVariableOffsets.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2438
    otherInfo := aPrototype class instanceVariableOffsets.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2439
    myInfo keysAndValuesDo:[:name :index | |varIndexAssoc|
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2440
        varIndexAssoc := otherInfo at:name ifAbsent:[].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2441
        varIndexAssoc notNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2442
            self instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2443
        ]
5755
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
    self isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2446
        1 to:(self basicSize min:aPrototype basicSize) do:[:index |
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2447
            self basicAt:index put:(aPrototype basicAt:index)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2448
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2449
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2450
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2451
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2452
     Class withoutUpdatingChangesDo:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2453
         Point subclass:#Point3D
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2454
           instanceVariableNames:'z'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2455
           classVariableNames:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2456
           poolDictionaries:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2457
           category:'testing'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2458
         (Point3D new cloneInstanceVariablesFrom:1@2) inspect.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2459
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2460
    "
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2463
     Class withoutUpdatingChangesDo:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2464
         Point variableSubclass:#Point3D
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2465
           instanceVariableNames:'z'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2466
           classVariableNames:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2467
           poolDictionaries:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2468
           category:'testing'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2469
         ((Point3D new:2) cloneInstanceVariablesFrom:#(1 2 3)) inspect.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2470
     ]
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2474
     |someObject|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2475
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2476
     Class withoutUpdatingChangesDo:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2477
         Object subclass:#TestClass1 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2478
           instanceVariableNames:'foo bar'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2479
           classVariableNames:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2480
           poolDictionaries:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2481
           category:'testing'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2482
         someObject := TestClass1 new.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2483
         someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2484
         Object subclass:#TestClass2 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2485
           instanceVariableNames:'bar foo'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2486
           classVariableNames:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2487
           poolDictionaries:''
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2488
           category:'testing'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2489
         (TestClass2 new cloneInstanceVariablesFrom:someObject) inspect.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2490
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2491
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2492
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2493
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2494
     |top b b1|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2495
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2496
     top := StandardSystemView new.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2497
     top extent:100@100.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2498
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2499
     b := Button in:top.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2500
     b label:'hello'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2501
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2502
     b1 := ArrowButton new cloneInstanceVariablesFrom:b.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2503
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2504
     top open.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2505
     b1 inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2506
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2507
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2508
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2509
copy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2510
    "return a copy of the receiver - defaults to shallowcopy here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2511
     Notice, that copy does not copy dependents."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2512
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2513
    ^ self shallowCopy postCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2514
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2515
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2516
copyToLevel:level
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2517
    "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
  2518
     Notice: 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2519
         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
  2520
         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
  2521
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2522
    |newObject class index|
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2523
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2524
    level == 1 ifTrue:[^ self shallowCopy].
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2525
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2526
    class := self class.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2527
    newObject := self clone.
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2528
    newObject == self ifTrue: [^ self].
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2529
    class isVariable ifTrue:[ 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2530
        index := self basicSize.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2531
        [index > 0] whileTrue:[
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2532
            newObject basicAt: index put: ((self basicAt: index) copyToLevel:(level-1)).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2533
            index := index - 1
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2534
        ]
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2535
    ].
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2536
    index := class instSize.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2537
    [index > 0] whileTrue:[
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2538
        newObject instVarAt: index put: ((self instVarAt: index) copyToLevel:(level-1)).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2539
        index := index - 1
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2540
    ].
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2541
    ^ newObject
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2542
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2543
    "
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2544
     |a b|
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2545
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2546
     a := #( 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2547
            '1.1' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2548
            '1.2' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2549
            '1.3'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2550
            ( 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2551
                '1.41' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2552
                '1.42' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2553
                '1.43'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2554
                    ( 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2555
                        '1.441' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2556
                        '1.442' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2557
                        '1.443'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2558
                        ( '1.4441' '1.4442' '1.4443' )
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2559
                        '1.445' 
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2560
                    )
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2561
                '1.45'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2562
            )
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2563
            '1.5'
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2564
           ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2565
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2566
      b := a copyToLevel:1.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2567
      self assert: ( (a at:1) == (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2568
      self assert: ( (a at:4) == (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2569
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2570
      b := a copyToLevel:2.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2571
      self assert: ( (a at:1) ~~ (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2572
      self assert: ( (a at:4) ~~ (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2573
      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
  2574
      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
  2575
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2576
      b := a copyToLevel:3.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2577
      self assert: ( (a at:1) ~~ (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2578
      self assert: ( (a at:4) ~~ (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2579
      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
  2580
      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
  2581
      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
  2582
      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
  2583
    "
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2584
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2585
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2586
deepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2587
    "return a copy of the object with all subobjects also copied.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2588
     This method DOES handle cycles/self-refs and preserves object identity; 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2589
     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
  2590
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2591
     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
  2592
     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
  2593
     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
  2594
     no cycles are involved, you can use the old simpleDeepCopy, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2595
     which avoids this overhead (but may run into trouble).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2596
     Notice, that deepCopy does not copy dependents."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2597
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2598
    ^ self deepCopyUsing:(IdentityDictionary new)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2599
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2600
    "an example which is not handled by the old deepCopy:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2601
    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2602
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2603
     a := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2604
     a at:3 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2605
     a deepCopy inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2606
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2607
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2608
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2609
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2610
     a := Color black onDevice:Screen current.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2611
     a deepCopy inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2612
    "
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
    "Modified: 27.3.1996 / 16:31:20 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2615
!
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
deepCopyError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2618
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2619
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2620
    "raise a signal, that deepCopy is not allowed for this object"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2621
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  2622
    ^ DeepCopyError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2623
!
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
deepCopyUsing:aDictionary
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2626
    "a helper for deepCopy; return a copy of the object with 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2627
     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
  2628
     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
  2629
     This method DOES handle cycles/self references."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2630
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2631
    |myClass aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2632
     sz "{ Class: SmallInteger }" 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2633
     iOrig iCopy|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2634
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2635
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2636
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2637
        sz := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2638
        aCopy := myClass basicNew:sz.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2639
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2640
        sz := 0.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2641
        aCopy := myClass basicNew
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2642
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2643
    aCopy setHashFrom:self.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2644
    aDictionary at:self put:aCopy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2645
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2646
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2647
     copy indexed instvars - if any
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2648
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2649
    sz ~~ 0 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2650
        myClass isBits ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2651
            "block-copy indexed instvars"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2652
            aCopy replaceFrom:1 to:sz with:self startingAt:1
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2653
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2654
            "individual deep copy the indexed variables"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2655
            1 to:sz do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2656
                iOrig := self basicAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2657
                iOrig notNil ifTrue:[
8372
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2658
                    "/ used to be dict-includesKey-ifTrue[dict-at:], 
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2659
                    "/ changed to use dict-at:ifAbsent:, to avoid double lookup in dictionary
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2660
                    iCopy := aDictionary at:iOrig ifAbsent:nil.
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2661
                    iCopy isNil ifTrue:[
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2662
                        iCopy := iOrig deepCopyUsing:aDictionary
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2663
                    ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2664
                    aCopy basicAt:i put:iCopy
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2665
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2666
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2667
        ]
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2670
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2671
     copy the instance variables
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
    sz := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2674
    1 to:sz do:[:i |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2675
        (self skipInstvarIndexInDeepCopy:i) ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2676
            iOrig := self instVarAt:i.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2677
            iOrig notNil ifTrue:[
8372
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2678
                iCopy := aDictionary at:iOrig ifAbsent:nil.
ef63fde56d72 deepCopyUsing slightly faster
ca
parents: 8371
diff changeset
  2679
                iCopy isNil ifTrue:[
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2680
                    iCopy := iOrig deepCopyUsing:aDictionary
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2681
                ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2682
                aCopy instVarAt:i put:iCopy
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2683
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2684
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2685
    ].
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2686
    aCopy postDeepCopyFrom:self.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2687
    ^ aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2688
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2689
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2690
     |a b c copyOfC|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2691
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2692
     a := Array with:'hello' with:'world' with:nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2693
     b := 99 @ 999.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2694
     a at:3 put:b.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2695
     c := Array with:a with:b with:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2696
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2697
     Transcript showCR: (c at:1) == (c at:3).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2698
     copyOfC := c deepCopy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2699
     Transcript showCR: (copyOfC at:1) == (copyOfC at:3)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2700
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2701
!
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
postCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2704
    "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
  2705
     cleanup after copying, while ST/X passes the original in postCopyFrom:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2706
     (see there)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2708
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2709
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2710
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2711
postDeepCopy
8930
edd42af66c0a deepCopy should not invoke postCopy
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2712
    "allows for cleanup after deep copying.
edd42af66c0a deepCopy should not invoke postCopy
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2713
     To be redefined in subclasses."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2714
!
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
postDeepCopyFrom:aSource
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2717
    "allows for cleanup after deep copying"
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
    ^ self postDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2720
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2721
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2722
setHashFrom:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2723
    "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
  2724
     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
  2725
     Smalltalks, and may not be available in future ST/X versions.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2726
     DO NEVER use this for normal application code."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2727
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2728
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2729
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2730
    REGISTER unsigned h;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2731
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2732
    if (__isNonNilObject(self) && __isNonNilObject(anObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2733
        h = __GET_HASH(anObject);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2734
        __SET_HASH(self, h);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2735
        RETURN (self);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2736
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2737
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2738
    self primitiveFailed    "neither receiver not arg may be nil or SmallInteger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2739
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2740
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2741
shallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2742
    "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
  2743
     i.e. the copy shares referenced instvars with its original."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2744
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2745
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2746
    int ninsts, spc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2747
    int sz;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2748
    OBJ theCopy;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2749
    OBJ cls;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2750
    int flags;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2751
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2752
    cls = __qClass(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2753
    flags = __intVal(__ClassInstPtr(cls)->c_flags);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2754
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2755
    /*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2756
     * bail out for special objects ..
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2757
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2758
    if (((flags & ~ARRAYMASK) == 0)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2759
     && ((flags & ARRAYMASK) != WKPOINTERARRAY)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2760
        sz = __qSize(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2761
        __PROTECT__(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2762
        __qNew(theCopy, sz);    /* OBJECT ALLOCATION */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2763
        __UNPROTECT__(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2764
        if (theCopy) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2765
            cls = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2766
            spc = __qSpace(theCopy);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2767
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2768
            theCopy->o_class = cls; __STORE_SPC(theCopy, cls, spc);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2769
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2770
            sz = sz - OHDR_SIZE;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2771
            if (sz) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2772
                char *src, *dst;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2773
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2774
                src = (char *)(__InstPtr(self)->i_instvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2775
                dst = (char *)(__InstPtr(theCopy)->i_instvars);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2776
#ifdef bcopy4
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2777
                {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2778
                    /* care for odd-number of longs */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2779
                    int nW = sz >> 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2780
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2781
                    if (sz & 3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2782
                        nW++;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2783
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2784
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2785
                    bcopy4(src, dst, nW);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2786
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2787
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2788
                bcopy(src, dst, sz);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2789
#endif
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2790
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2791
                flags &= ARRAYMASK;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2792
                if (flags == POINTERARRAY) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2793
                    ninsts = __BYTES2OBJS__(sz);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2794
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2795
                    ninsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2796
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2797
                if (ninsts) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2798
                    do {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2799
                        OBJ el;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2800
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2801
                        el = __InstPtr(theCopy)->i_instvars[ninsts-1];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2802
                        __STORE_SPC(theCopy, el, spc);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2803
                    } while (--ninsts);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2804
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2805
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2806
            RETURN (theCopy);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2807
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2808
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2809
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2810
    "/ fallBack for special objects & memoryAllocation failure case
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2811
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2812
    ^ self slowShallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2813
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2814
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2815
simpleDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2816
    "return a copy of the object with all subobjects also copied.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2817
     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
  2818
     slightly faster copy in situations where it is known that
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2819
     no recursive references occur (LargeIntegers for example).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2820
     NOTICE: you will run into trouble, when trying this with recursive
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2821
     objects (usually recursionInterrupt or memory-alert).
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2822
     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
  2823
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2824
    |myClass aCopy|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2825
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2826
    (myClass := self class) isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2827
        aCopy := myClass basicNew:(self basicSize).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2828
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2829
        aCopy := myClass basicNew
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2830
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2831
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2832
    "copy the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2833
    aCopy cloneFrom:self performing:#simpleDeepCopy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2834
    ^ aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2835
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2836
    "a bad example (but ST/X should survive ...)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2837
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2838
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2839
     a := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2840
     a at:3 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2841
     a simpleDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2842
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2843
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2844
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2845
skipInstvarIndexInDeepCopy:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2846
    "a helper for deepCopy; only indices for which this method returns
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2847
     false are copied in a deep copy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2848
     The default is false here - which means that everything is copied.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2849
     Can be redefined in subclasses for partial copies"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2850
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2851
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2852
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2853
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2854
slowShallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2855
    "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
  2856
     i.e. the copy shares referenced instvars with its original.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2857
     This method is only invoked as a fallback from #shallowCopy."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2858
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2859
    |myClass aCopy|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2860
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2861
    (myClass := self class) isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2862
        aCopy := myClass basicNew:(self basicSize).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2863
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2864
        aCopy := myClass basicNew
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2865
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2866
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2867
    "copy the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2868
    aCopy cloneFrom:self performing:#yourself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2869
    ^ aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2870
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2871
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2872
!Object methodsFor:'debugging'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2873
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2874
assert:aBooleanOrBlock
6964
a9ecdb3f1e52 comments
Claus Gittinger <cg@exept.de>
parents: 6963
diff changeset
  2875
    "fail, if the argument is not true and report an error"
a9ecdb3f1e52 comments
Claus Gittinger <cg@exept.de>
parents: 6963
diff changeset
  2876
8876
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2877
    aBooleanOrBlock == true ifTrue:[^ self].
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2878
    "/ could still be a block or false.
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2879
    self 
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2880
        assert:aBooleanOrBlock 
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2881
        message:('Assertion failed in ' , thisContext sender printString)
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2882
!
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2883
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2884
assert:aBooleanOrBlock message:messageIfFailing
6964
a9ecdb3f1e52 comments
Claus Gittinger <cg@exept.de>
parents: 6963
diff changeset
  2885
    "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
  2886
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2887
    "{ Pragma: +optSpace }"
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2888
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2889
    (aBooleanOrBlock value) ifFalse:[
8273
72c29dfc55af may proceed for assert
penk
parents: 7983
diff changeset
  2890
        self error:messageIfFailing mayProceed:true
6961
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2891
    ].
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2892
!
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2893
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2894
basicInspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2895
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2896
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2897
    "launch an inspector on the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2898
     this method should NOT be redefined in subclasses."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2899
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2900
    Inspector isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2901
        "
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2902
         for systems without GUI
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2903
        "
6926
72f1a7eb34f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6918
diff changeset
  2904
        self warn:'No Inspector defined (Inspector is nil).' 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2905
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2906
        Inspector openOn:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2907
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2908
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2909
    "Modified: 18.5.1996 / 15:43:25 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2910
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2911
6954
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2912
breakPoint:something
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2913
    "{ Pragma: +optSpace }"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2914
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2915
    "Like halt, but disabled by default.
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2916
     Can be easily enabled.
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2917
     Can be filtered on the arguments value (typically: a symbol).
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2918
     Code with breakpoints may be even checked into the source repository"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2919
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2920
    "Example:   nil breakPoint:#stefan"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2921
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2922
"/    something = OperatingSystem getLoginName ifTrue:[
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2923
"/        ^ HaltSignal raiseRequestWith:something errorString:'Breakpoint encountered: ', something printString
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2924
"/    ].
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2925
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2926
"/    something = 'testThis' ifTrue:[
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2927
"/        ^ HaltSignal raiseRequestWith:something errorString:'Breakpoint encountered: ', something printString
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2928
"/    ].
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2929
!
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2930
5995
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2931
browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2932
    "open a browser on the receivers class"
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2933
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2934
    self class theNonMetaclass browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2935
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2936
    "
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2937
     10 browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2938
     Collection browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2939
     Collection class browse
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2940
    "
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2941
!
21ba36ffaf3e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5980
diff changeset
  2942
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2943
inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2944
    "{ Pragma: +optSpace }"
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
    "launch an inspector on the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2947
     this method (or better: inspectorClass) can be redefined in subclasses 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2948
     to start special inspectors."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2949
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2950
    |cls|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2951
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2952
    cls := self inspectorClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2953
    cls isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2954
        ^ self basicInspect
5755
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
    cls openOn:self
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
     Object new inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2960
     (1 @ 2) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2961
     Smalltalk inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2962
     #(1 2 3) asOrderedCollection inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2963
     (Color red) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2964
     (Image fromFile:'bitmaps/garfield.gif') inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2965
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2966
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2967
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2968
inspectorClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2969
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2970
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2971
    "return the class to use for inspect. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2972
     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
  2973
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2974
    ^ Inspector
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
mustBeBoolean
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2978
    "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
  2979
     in an if* or while* message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2980
     Caveat: for now, this is only sent by the interpreter;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2981
     both the JIT and the stc compiler treat it as undefined."
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 error:'Non boolean receiver - proceed for truth' mayProceed:true.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2984
    ^ true
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2987
mustBeKindOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2988
    "for compatibility & debugging support: 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2989
     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
  2990
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2991
        it is VERY questionable, if it makes sense to add manual
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2992
        type checks to a dynamically typed language like smalltalk. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2993
        It will, at least, slow down performance,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2994
        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
  2995
        of this selector. Also, read the comment in isKindOf:, regarding the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  2996
        use of isXXX check methods.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2997
     You see: The author does not like this at all ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2998
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2999
    (self isKindOf:aClass) ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3000
        self error:'argument is not of expected type'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3001
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3002
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3003
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3004
obsoleteFeatureWarning
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3005
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3006
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3007
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3008
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3009
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3010
     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
  3011
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3012
    self obsoleteFeatureWarning:nil from:thisContext sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3013
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3014
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3015
obsoleteFeatureWarning:message
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3016
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3017
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3018
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3019
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3020
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3021
     Hopefully, this warning message is annoying enough for you to change the code... ;-).
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3022
     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
  3023
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3024
    self obsoleteFeatureWarning:message from:thisContext sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3025
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3026
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3027
obsoleteFeatureWarning:message from:aContext
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3028
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3029
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3030
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3031
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3032
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3033
     Hopefully, this warning message is annoying enough for you to change the code... ;-).
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3034
     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
  3035
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3036
    |spec|
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3037
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3038
    spec := aContext methodPrintString.
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3039
    ('WARNING: the ''' , spec , ''' semantics will be changed.') infoPrintCR.
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3040
    ('         Its behavior may be different in future ST/X versions.') infoPrintCR.
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3041
    ('         called from ' , aContext sender printString) infoPrintCR.
7204
e968d9923408 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7202
diff changeset
  3042
    (aContext sender selector startsWith:'perform:') ifTrue:[
e968d9923408 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7202
diff changeset
  3043
    ('         called from ' , aContext sender sender printString) infoPrintCR.
e968d9923408 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7202
diff changeset
  3044
    ].
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3045
    message notNil ifTrue:[
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3046
        '------>  ' infoPrint. message infoPrintCR
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3047
    ]
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3048
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3049
    "
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3050
     Object obsoleteFeatureWarning:'foo' from:thisContext sender sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3051
    "
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3052
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3053
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3054
obsoleteMethodWarning
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3055
    "{ Pragma: +optSpace }"
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
    "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
  3058
     this method is used to tell programmers that a method is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3059
     used which is going to be removed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3060
     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
  3061
     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
  3062
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3063
    self obsoleteMethodWarning:nil from:thisContext sender
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3064
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3065
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3066
obsoleteMethodWarning:message
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3067
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3068
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3069
    "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
  3070
     this method is used to tell programmers that a method is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3071
     used which is going to be removed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3072
     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
  3073
     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
  3074
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3075
    self obsoleteMethodWarning:message from:thisContext sender
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3076
!
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3077
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3078
obsoleteMethodWarning:message from:aContext
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3079
    "{ Pragma: +optSpace }"
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3080
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3081
    "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
  3082
     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
  3083
     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
  3084
     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
  3085
     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
  3086
     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
  3087
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3088
    |spec sender|
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3089
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3090
    Smalltalk isStandAloneApp ifTrue:[
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3091
        "ignore in production systems"
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3092
        ^ self.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3093
    ].
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3094
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3095
    spec := aContext methodPrintString.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3096
    sender := aContext sender.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3097
    ('WARNING: the ''' , spec , ''' method is obsolete.') infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3098
    ('         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
  3099
    ('         called from ' , sender printString) infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3100
    (sender selector startsWith:'perform:') ifTrue:[
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3101
        sender := sender sender.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3102
        (sender selector startsWith:'perform:') ifTrue:[
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3103
            sender := sender sender.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3104
        ].
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3105
        ('         called from ' , sender printString) infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3106
    ].
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3107
    message notNil ifTrue:[
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3108
        '------>  ' infoPrint. message infoPrintCR
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3109
    ]
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3110
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3111
    "
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3112
     Object obsoleteMethodWarning:'foo' from:thisContext sender sender
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3113
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3114
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3115
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3116
!Object methodsFor:'dependents access'!
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
addDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3119
    "make the argument, anObject be a dependent of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3120
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3121
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3122
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3123
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3124
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3125
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3126
    "/ faster execution.
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
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3129
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3130
        |deps dep|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3131
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3132
        deps := self dependents.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3133
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3134
        "/ to save a fair amount of memory in case of
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3135
        "/ many dependencies, we store a single dependent in
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3136
        "/ a WeakArray, and switch to a WeakSet if more dependents are
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3137
        "/ added.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3138
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3139
        (deps isNil or:[deps size == 0]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3140
            self dependents:(WeakArray with:anObject)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3141
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3142
            deps class == WeakArray ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3143
                dep := deps at:1.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3144
                dep ~~ anObject ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3145
                    (dep isNil or:[dep == 0]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3146
                        deps at:1 put:anObject
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3147
                    ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3148
                        self dependents:(WeakIdentitySet with:dep with:anObject)
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
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3151
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3152
                deps add:anObject
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3153
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3154
        ]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3155
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3156
        wasBlocked ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3157
            OperatingSystem unblockInterrupts
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3158
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3159
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3160
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3161
    "Modified: / 27.10.1997 / 19:35:52 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3162
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3163
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3164
breakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3165
    "remove all dependencies from the receiver"
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
    self dependents:nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3168
    self nonWeakDependents:nil
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
    "Modified: / 19.4.1996 / 10:55:36 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3171
    "Created: / 27.2.1998 / 11:26:11 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3172
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3173
8542
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3174
breakDependentsRecursively
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3175
    "remove all dependencies from the receiver and 
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3176
     recursively from all objects referred to by the receiver."
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3177
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3178
    self breakDependents.
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3179
    1 to:self class instSize do:[:idx | 
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3180
        (self instVarAt:idx) breakDependentsRecursively.
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3181
    ].
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3182
    1 to:self basicSize do:[:idx | 
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3183
        (self basicAt:idx) breakDependentsRecursively.
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3184
    ]
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3185
!
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3186
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3187
dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3188
    "return a Collection of dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3189
     The default implementation here uses a global WeakDictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3190
     dependents 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3191
     This may be too slow for high frequency change&update,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3192
     therefore, some classes (Model) redefine this for better performance.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3193
     Notice the mentioning of a WeakDictionary - read the classes documentation."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3194
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3195
    |deps|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3196
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3197
    (deps := Dependencies at:self ifAbsent:nil) isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3198
        ^ #().
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3199
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3200
    ^ deps
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3201
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3202
    "Modified: / 26.1.1998 / 11:18:15 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3203
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3204
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3205
dependents:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3206
    "set the collection of dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3207
     The default implementation here uses a global Dictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3208
     dependents which may be too slow for high frequency change&update.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3209
     Therefore, some classes (Model) redefine this for better performance."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3210
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3211
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3212
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3213
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3214
    "/ faster execution (and to avoid creation of garbage blocks).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3215
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3216
    (OperatingSystem blockInterrupts) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3217
        "/ the common case - already blocked
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3218
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3219
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3220
            Dependencies removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3221
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3222
            Dependencies at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3223
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3224
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3225
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3226
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3227
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3228
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3229
            Dependencies removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3230
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3231
            Dependencies at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3232
        ].
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3233
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3234
        OperatingSystem unblockInterrupts
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3235
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3236
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3237
    "Modified: 30.1.1997 / 21:22:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3238
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3239
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3240
dependentsDo:aBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3241
    "evaluate aBlock for all of my dependents"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3242
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3243
    |deps nwDeps|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3244
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3245
    deps := self dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3246
    deps size ~~ 0 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3247
        deps do:[:d | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3248
                    (d notNil and:[d ~~ 0]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3249
                        aBlock value:d
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3250
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3251
                ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3252
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3253
    nwDeps := self nonWeakDependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3254
    (nwDeps ~~ deps and:[nwDeps size ~~ 0]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3255
        nwDeps do:aBlock 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3256
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3257
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3258
    "Modified: / 30.1.1998 / 14:03:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3259
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3260
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3261
myDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3262
    "same as dependents - ST-80 compatibility"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3263
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3264
    ^ self dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3265
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3266
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3267
release
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3268
    "remove all references to objects that may refer to self.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3269
     Subclasses may redefine this method but should do a 'super release'."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3270
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3271
    self breakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3272
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3273
    "Modified: / 27.2.1998 / 11:29:35 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3274
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3275
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3276
removeDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3277
    "make the argument, anObject be independent of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3278
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3279
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3280
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3281
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3282
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3283
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3284
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3285
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3286
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3287
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3288
        |deps n d|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3289
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3290
        deps := self dependents.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3291
        deps size ~~ 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3292
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3293
            "/ to save a fair amount of memory in case of
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3294
            "/ many dependencies, we store a single dependent in
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3295
            "/ a WeakArray, and switch to a WeakSet if more dependents are
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3296
            "/ added. Here we have to do the inverse ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3297
9240
271ab8ebb7de *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9221
diff changeset
  3298
            ((deps class == WeakArray) or:[deps class == Array]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3299
                ((d := deps at:1) == anObject 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3300
                or:[d isNil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3301
                or:[d == 0]]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3302
                    self dependents:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3303
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3304
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3305
                deps remove:anObject ifAbsent:[].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3306
                (n := deps size) == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3307
                    self dependents:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3308
                ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3309
                    n == 1 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3310
                        d := deps firstIfEmpty:nil.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3311
                        d notNil ifTrue:[
9246
601ed6b6b95d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9240
diff changeset
  3312
                            deps := (deps isWeakCollection ifTrue:WeakArray ifFalse:Array) with:d
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3313
                        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3314
                            deps := nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3315
                        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3316
                        self dependents:deps.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3317
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3318
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3319
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3320
        ]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3321
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3322
        wasBlocked ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3323
            OperatingSystem unblockInterrupts
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3324
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3325
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3326
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3327
    "Modified: / 26.1.1998 / 19:51:50 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3328
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3329
7266
f2b64d3b43cf method category rename
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3330
!Object methodsFor:'dependents access (non weak)'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3331
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3332
addNonWeakDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3333
    "make the argument, anObject be a nonWeak dependent of the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3334
     Be careful: this nonWeakDependency will prevent the dependent from being 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3335
     garbage collected unless the dependency is removed.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3336
     This is a private mechanism, for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3337
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3338
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3339
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3340
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3341
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3342
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3343
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3344
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3345
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3346
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3347
        |deps dep|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3348
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3349
        deps := self nonWeakDependents.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3350
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3351
        "/ to save a fair amount of memory in case of
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3352
        "/ many dependencies, we store a single dependent in
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3353
        "/ an Array, and switch to a Set if more dependents are
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3354
        "/ added.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3355
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3356
        deps size == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3357
            self nonWeakDependents:(Array with:anObject)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3358
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3359
            deps class == Array ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3360
                dep := deps at:1.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3361
                dep ~~ anObject ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3362
                    self nonWeakDependents:(IdentitySet with:dep with:anObject)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3363
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3364
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3365
                deps add:anObject
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3366
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3367
        ]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3368
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3369
        wasBlocked ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3370
            OperatingSystem unblockInterrupts
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3371
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3372
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3373
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3374
    "Created: / 19.4.1996 / 10:54:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3375
    "Modified: / 30.1.1998 / 14:03:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3376
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3377
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3378
nonWeakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3379
    "return a Collection of nonWeakDependents - empty if there is none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3380
     This is a private mechanism for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3381
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3382
    NonWeakDependencies isNil ifTrue:[^ #()].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3383
    ^ NonWeakDependencies at:self ifAbsent:#()
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3384
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3385
    "Created: / 19.4.1996 / 10:55:06 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3386
    "Modified: / 30.1.1998 / 14:06:47 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3387
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3388
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3389
nonWeakDependents:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3390
    "set the collection of nonWeak dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3391
     This is a private helper for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3392
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3393
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3394
        (aCollection isNil or:[aCollection isEmpty]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3395
            NonWeakDependencies removeKey:self ifAbsent:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3396
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3397
            NonWeakDependencies at:self put:aCollection
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3398
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3399
    ] valueUninterruptably
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3400
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3401
    "Created: 19.4.1996 / 11:07:47 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3402
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3403
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3404
removeNonWeakDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3405
    "remove a nonWeak dependency from the receiver to the argument, anObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3406
     (i.e. make it independent of the receiver)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3407
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3408
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3409
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3410
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3411
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3412
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3413
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3414
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3415
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3416
    [
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3417
        |deps n|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3418
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3419
        deps := self nonWeakDependents.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3420
        deps size ~~ 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3421
            deps class == Array ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3422
                (deps at:1) == anObject ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3423
                    self nonWeakDependents:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3424
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3425
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3426
                deps remove:anObject ifAbsent:[].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3427
                (n := deps size) == 0 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3428
                    self nonWeakDependents:nil
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3429
                ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3430
                    n == 1 ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3431
                        self nonWeakDependents:(Array with:(deps first))
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3432
                    ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3433
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3434
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3435
        ]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3436
    ] ensure:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3437
        wasBlocked ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3438
            OperatingSystem unblockInterrupts
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3439
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3440
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3441
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3442
    "Created: / 19.4.1996 / 11:44:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3443
    "Modified: / 30.1.1998 / 14:04:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3444
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3445
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3446
!Object methodsFor:'dependents-interests'!
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
addInterest:anInterest
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3449
    "install an interest forwarder.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3450
     Here, we use the nonWeakDependencies."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3451
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3452
    self addNonWeakDependent:anInterest
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3453
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3454
    "Created: 14.10.1996 / 22:27:34 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3455
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3456
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3457
expressInterestIn:aspect for:anObject sendBack:aSelector
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3458
    "arrange for aSelector to be sent to anObject whenever the receiver
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3459
     changes aspect."
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
    "/ for now, use an interestConverter, which is somewhat less efficient.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3462
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3463
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3464
    self addInterest:(InterestConverter 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3465
                            destination:anObject 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3466
                            selector:aSelector 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3467
                            aspect:aspect)
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3468
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3469
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3470
     |p b|
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
     b := [Transcript showCR:' -> the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3473
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3474
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3475
     Transcript showCR:'interest in #foo:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3476
     p expressInterestIn:#foo for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3477
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3478
     Transcript showCR:'now changing #bar ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3479
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3480
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3481
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3482
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3483
     Transcript showCR:'now changing #foo ... (expect notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3484
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3485
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3486
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3487
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3488
     Transcript showCR:'no more interest in #foo:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3489
     p retractInterestIn:#foo for:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3490
     Transcript showCR:'now changing #foo ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3491
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3492
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3493
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3494
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3495
     Transcript showCR:'interest in #bar now:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3496
     p expressInterestIn:#bar for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3497
     Transcript showCR:'now changing #foo ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3498
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3499
     Transcript showCR:'now changing #bar ... (expect notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3500
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3501
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3502
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3503
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3504
     Transcript showCR:'interest in #foo now:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3505
     p expressInterestIn:#foo for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3506
     Transcript showCR:'now changing #foo ... (expect notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3507
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3508
     Transcript showCR:'now changing #bar ... (expect notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3509
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3510
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3511
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3512
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3513
     Transcript showCR:'no more interests:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3514
     p retractInterestsFor:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3515
     Transcript showCR:'now changing #foo ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3516
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3517
     Transcript showCR:'now changing #bar...  (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3518
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3519
     Transcript cr.
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
     p release.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3522
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3523
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3524
    "Created: 19.4.1996 / 10:26:22 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3525
    "Modified: 19.4.1996 / 12:34:08 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3526
    "Modified: 14.10.1996 / 22:28:20 / stefan"
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
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3529
interests
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3530
    "return a Collection of interests - empty if there is none.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3531
     Here, we use the nonWeakDependents for interests."
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
    ^ self nonWeakDependents
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3534
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3535
    "Created: / 14.10.1996 / 22:20:51 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3536
    "Modified: / 30.1.1998 / 14:07:35 / cg"
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
interestsFor:someOne
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3540
    "return a collection of interests of someOne - empty if there is none."
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
    |coll deps|
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
    deps := self interests.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3545
    deps size == 0 ifTrue:[^ #()].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3546
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3547
    coll := IdentitySet new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3548
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3549
    deps do:[:dep |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3550
        (dep isInterestConverter) ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3551
            dep destination == someOne ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3552
                coll add:dep.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3553
            ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3554
        ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3555
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3556
    ^ coll
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3557
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3558
    "Created: / 30.1.1998 / 14:02:26 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3559
    "Modified: / 30.1.1998 / 14:08:24 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3560
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3561
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3562
onChangeEvaluate:aBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3563
    "arrange for aBlock to be evaluated whenever the receiver changes."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3564
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3565
    ^ self onChangeSend:#value to:aBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3566
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3567
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3568
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3569
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3570
     b := [Transcript showCR:' -> the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3571
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3572
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3573
     Transcript showCR:'interest in #foo:'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3574
     p onChangeEvaluate:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3575
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3576
     Transcript showCR:'now changing #bar ... (expect no notification)'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3577
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3578
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3579
     p retractInterests.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3580
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3581
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3582
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3583
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3584
onChangeSend:aSelector to:anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3585
    "arrange for aSelector to be sent to anObject whenever the receiver
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3586
     changes."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3587
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3588
    "/ for now, use an interestConverter, which is somewhat less efficient.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3589
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3590
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3591
    ((self interests ? #())
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3592
        contains:[:anInterest |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3593
            (anInterest isInterestConverter)
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3594
            and:[ anInterest destination == anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3595
            and:[ anInterest selector == aSelector]]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3596
        ])
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3597
            ifTrue:[^ self].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3598
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3599
    self addInterest:(InterestConverter 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3600
                          destination:anObject 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3601
                          selector:aSelector)
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3602
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3603
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3604
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3605
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3606
     b := [Transcript showCR:'the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3607
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3608
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3609
     p onChangeSend:#value to:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3610
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3611
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3612
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3613
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3614
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3615
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3616
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3617
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3618
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3619
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3620
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3621
     Transcript showCR:'no more interest'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3622
     p retractInterestsFor:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3623
     Transcript showCR:'now changing again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3624
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3625
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3626
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3627
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3628
     Transcript showCR:'interest again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3629
     p onChangeSend:#value to:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3630
     Transcript showCR:'now changing again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3631
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3632
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3633
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3634
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3635
    "Created: 19.4.1996 / 10:26:38 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3636
    "Modified: 19.4.1996 / 12:34:26 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3637
    "Modified: 14.10.1996 / 22:28:27 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3638
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3639
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3640
removeInterest:anInterest
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3641
    "remove an interest forwarder.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3642
     Here, we use the nonWeakDependencies."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3643
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3644
    self removeNonWeakDependent:anInterest
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3645
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3646
    "Created: 14.10.1996 / 22:21:59 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3647
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3648
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3649
retractInterestIn:aspect for:someOne
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3650
    "remove the interest of someOne in the receiver changing aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3651
     (as installed with #expressInterestIn:for:sendBack:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3652
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3653
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3654
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3655
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3656
    self retractInterestsForWhich:[:i | (i aspect == aspect) and:[i destination == someOne]]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3657
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3658
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3659
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3660
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3661
     b := [Transcript showCR:'the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3662
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3663
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3664
     Transcript showCR:'interest in #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3665
     p expressInterestIn:#foo for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3666
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3667
     Transcript showCR:'now changing #bar'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3668
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3669
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3670
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3671
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3672
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3673
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3674
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3675
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3676
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3677
     Transcript showCR:'no more interest in #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3678
     p retractInterestIn:#foo for:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3679
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3680
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3681
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3682
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3683
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3684
     Transcript showCR:'interest in #bar now'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3685
     p expressInterestIn:#bar for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3686
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3687
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3688
     Transcript showCR:'now changing #bar'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3689
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3690
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3691
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3692
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3693
     Transcript showCR:'interest in #foo now'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3694
     p expressInterestIn:#foo for:b sendBack:#value.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3695
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3696
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3697
     Transcript showCR:'now changing #bar'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3698
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3699
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3700
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3701
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3702
     Transcript showCR:'no more interests'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3703
     p retractInterestsFor:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3704
     Transcript showCR:'now changing #foo'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3705
     p changed:#foo.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3706
     Transcript showCR:'now changing #bar'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3707
     p changed:#bar.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3708
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3709
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3710
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3711
    "Created: / 19.4.1996 / 10:27:11 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3712
    "Modified: / 14.10.1996 / 22:21:19 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3713
    "Modified: / 30.1.1998 / 14:05:34 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3714
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3715
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3716
retractInterests
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3717
    "remove all interests in the receiver changing aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3718
     (as installed with #expressInterestIn:for:sendBack:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3719
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3720
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3721
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3722
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3723
    self retractInterestsForWhich:[:i | true ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3724
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3725
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3726
retractInterestsFor:someOne
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3727
    "remove the interest of someOne in the receiver 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3728
     (as installed with #onChangeSend:to:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3729
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3730
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3731
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3732
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3733
    self retractInterestsForWhich:[:i | i destination == someOne ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3734
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3735
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3736
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3737
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3738
     b := [Transcript showCR:'the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3739
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3740
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3741
     p onChangeSend:#value to:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3742
     p x:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3743
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3744
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3745
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3746
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3747
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3748
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3749
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3750
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3751
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3752
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3753
     Transcript showCR:'no more interest'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3754
     p retractInterestsFor:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3755
     Transcript showCR:'now changing again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3756
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3757
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3758
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3759
     Delay waitForSeconds:1.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3760
     Transcript showCR:'interest again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3761
     p onChangeSend:#value to:b.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3762
     Transcript showCR:'now changing again'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3763
     p changed.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3764
     Transcript cr.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3765
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3766
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3767
    "Created: / 19.4.1996 / 10:23:46 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3768
    "Modified: / 14.10.1996 / 22:21:25 / stefan"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3769
    "Modified: / 30.1.1998 / 14:04:52 / cg"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3770
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3771
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3772
retractInterestsForWhich:aBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3773
    "remove all interests in the receiver changing aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3774
     (as installed with #expressInterestIn:for:sendBack:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3775
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3776
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3777
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3778
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3779
    |deps coll|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3780
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3781
    deps := self interests.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3782
    deps size ~~ 0 ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3783
        "/ cannot removeDependent within the loop - the interests collection rehashes
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3784
        coll := OrderedCollection new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3785
        deps do:[:dep |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3786
            dep isInterestConverter ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3787
                (aBlock value:dep) ifTrue:[coll add:dep].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3788
            ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3789
        ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3790
        coll do:[:dep |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3791
            self removeInterest:dep.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3792
        ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3793
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3794
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3795
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3796
retractInterestsIn:aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3797
    "remove all interests in the receiver changing aspect
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3798
     (as installed with #expressInterestIn:for:sendBack:)."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3799
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3800
    "/ for now, remove the interestConverter.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3801
    "/ In the future, a more intelligent DependencyCollection class is planned for
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3802
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3803
    self retractInterestsForWhich:[:i | i aspect == aspect ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3804
! !
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3805
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3806
!Object methodsFor:'dependents-st/v event simulation'!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3807
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3808
removeActionsForEvent:eventName
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3809
    "remove ST/V-style event triggers."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3810
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3811
    self retractInterestsIn:eventName
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3812
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3813
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3814
removeAllActionsWithReceiver:anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3815
    "remove ST/V-style event triggers."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3816
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3817
    self retractInterestsFor:anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3818
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3819
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3820
triggerEvent:eventSymbol withArguments:parameters
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3821
    "perform ST/V-style event triggering."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3822
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3823
    self changed:eventSymbol with:parameters.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3824
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3825
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3826
when:eventSymbol send:selector to:anObject
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3827
    "install an ST/V-style interest forwarder.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3828
     Here, we use the nonWeakDependencies."
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3829
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3830
    self addInterest:(InterestConverterWithParameters
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3831
                            destination:anObject 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3832
                            selector:selector 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3833
                            aspect:eventSymbol).
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3834
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3835
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3836
     |p b|
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3837
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3838
     b := [Transcript showCR:'the point changed'].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3839
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3840
     p := Point new.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3841
     p whem:#foo:bar: send:#value:value: to:[:a :b | Transcript show:'foo: '; show:a; show:' bar: '; showCR:b].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3842
     Transcript showCR:'now changing'.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3843
     p triggerEvent:#foo:bar: withArguments:#('fooArg' 'barArg').
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3844
     p retracrtInterests.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3845
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3846
! !
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3847
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3848
!Object methodsFor:'displaying'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3849
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3850
ascentOn:aGC
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3851
    "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
  3852
     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
  3853
     coordinate is given by y.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3854
     In other words: some draw above the given y coordinate.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3855
     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
  3856
     the given y coordinate."
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3857
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3858
    ^ (aGC font onDevice:aGC device) ascent
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3859
!
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3860
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3861
displayOn:aGCOrStream
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3862
    "Compatibility
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3863
     append a printed desription on some stream (Dolphin,  Squeak)
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3864
     OR:
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3865
     display the receiver in a graphicsContext at 0@0 (ST80).
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3866
     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
  3867
     (although the fallBack is to display its printString ...)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3868
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3869
    "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3870
    "/ 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
  3871
    (aGCOrStream isStream or:[aGCOrStream == Transcript]) ifTrue:[
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3872
        self printOn:aGCOrStream.
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3873
        ^ self
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3874
    ].
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3875
    ^ self displayOn:aGCOrStream x:0 y:0.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3876
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3877
    "Created: 29.5.1996 / 16:28:58 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3878
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3879
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3880
displayOn:aGC at:aPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3881
    "ST-80 Compatibility
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3882
     display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3883
     for any object to be displayed in a ListView - for example."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3884
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3885
    ^ self displayOn:aGC x:(aPoint x) y:(aPoint y).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3886
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3887
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3888
displayOn:aGC x:x y:y
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3889
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3890
     for any object to be displayed in a ListView - for example."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3891
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3892
    self displayOn:aGC x:x y:y opaque:false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3893
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3894
    "Modified: 29.5.1996 / 16:29:38 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3897
displayOn:aGc x:x y:y opaque:opaque
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3898
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3899
     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
  3900
     The fallBack here shows the receivers displayString.
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3901
     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
  3902
     ask using #ascentOn: if required"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3903
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3904
    |s yBaseline|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3905
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3906
    s := self displayString.
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3907
    yBaseline := y "+ aGc font ascent".
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3908
    opaque ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3909
        aGc displayOpaqueString:s x:x y:yBaseline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3910
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3911
        aGc displayString:s x:x y:yBaseline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3912
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3913
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3914
    "Modified: 29.5.1996 / 16:29:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3915
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3916
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3917
displayOpaqueOn:aGC x:x y:y
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3918
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3919
     for any object to be displayed in a ListView - for example."
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
    self displayOn:aGC x:x y:y opaque:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3922
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3923
    "Modified: / 29.5.1996 / 16:29:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3924
    "Created: / 26.10.1997 / 15:01:36 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3925
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3926
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3927
displayString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3928
    "return a string used when displaying the receiver in a view;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3929
     for example an Inspector. This is usually the same as printString,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3930
     but sometimes redefined for a better look."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3931
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3932
    |s|
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3933
8322
95ca965f65ed Handle unicode in #displayString
Stefan Vogel <sv@exept.de>
parents: 8300
diff changeset
  3934
    s := CharacterWriteStream on:(String new:32).
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3935
    self displayOn:s.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3936
    ^ s contents
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3937
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3938
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3939
     #(1 2 3) printString    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3940
     #(1 2 3) displayString  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3941
     #(1 2 3) storeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3942
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3943
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3944
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3945
heightOn:aGC
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3946
    "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
  3947
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3948
    ^ (aGC font onDevice:aGC device) heightOf:(self displayString)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3949
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3950
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3951
widthFrom:startIndex to:endIndex on:aGC
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3952
    "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
  3953
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3954
    ^ (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
  3955
!
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3956
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3957
widthOn:aGC
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3958
    "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
  3959
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3960
    ^ (aGC font onDevice:aGC device) widthOf:(self displayString)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3961
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3962
7359
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3963
!Object methodsFor:'double dispatching'!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3964
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3965
equalFromComplex:aComplex
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3966
    "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
  3967
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3968
     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
  3969
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3970
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3971
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3972
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3973
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3974
equalFromFixedPoint:aFixedPoint
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3975
    "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
  3976
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3977
     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
  3978
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3979
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3980
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3981
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3982
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3983
equalFromFloat:aFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3984
    "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
  3985
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3986
     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
  3987
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3988
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3989
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3990
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3991
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3992
equalFromFraction:aFraction
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3993
    "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
  3994
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3995
     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
  3996
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3997
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3998
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3999
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4000
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4001
equalFromInteger:anInteger
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4002
    "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
  4003
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4004
     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
  4005
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4006
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4007
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4008
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4009
7455
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  4010
equalFromLargeFloat:aLargeFloat
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  4011
    "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
  4012
     and return false from this comparison.
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  4013
     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
  4014
     which uses #= (i.e. a Set or Dictionary)."
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  4015
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  4016
    ^ false
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  4017
!
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  4018
7359
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4019
equalFromLongFloat:aLongFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4020
    "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
  4021
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4022
     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
  4023
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4024
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4025
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4026
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4027
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4028
equalFromShortFloat:aShortFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4029
    "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
  4030
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4031
     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
  4032
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4033
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4034
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4035
! !
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  4036
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4037
!Object methodsFor:'encoding & decoding'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4038
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4039
decodeAsLiteralArray
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4040
    "given a literalEncoding in the receiver,
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4041
     create & return the corresponding object.
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4042
     The inverse operation to #literalArrayEncoding."
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4043
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4044
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4045
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4046
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4047
encodeOn:anEncoder with:aParameter
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4048
    "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
  4049
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4050
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4051
8404
c0bd2a56dc3b *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 8397
diff changeset
  4052
    self acceptVisitor:anEncoder with:aParameter
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4053
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4054
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4055
encodingVectorForInstanceVariables
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4056
    "OBSOLETE, use elementDescriptorForInstanceVariables"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4057
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4058
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4059
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4060
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | true].
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4061
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4062
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4063
      #(1 2 3 nil true symbol) encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4064
      Dictionary new encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4065
      (5 @ nil) encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4066
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4067
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4068
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4069
encodingVectorForNonNilInstanceVariables
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4070
    "OBSOLETE, use elementDescriptorForNonNilInstanceVariables"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4071
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4072
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4073
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4074
    ^ self elementDescriptorForInstanceVariablesMatching:[:varVal | varVal notNil].
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4075
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4076
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4077
      #(1 2 3 nil true symbol) encodingVectorForNonNilInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4078
      (5 @ nil) encodingVectorForNonNilInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4079
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4080
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4081
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4082
fromLiteralArrayEncoding:aSpecArray
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4083
    "read my attributes from aSpecArray.
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4084
     Recursively decodes arguments."
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4085
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4086
    |sel litVal val
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4087
     stop   "{ Class:SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4088
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4089
    stop := aSpecArray size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4090
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4091
    2 to:stop by:2 do:[:i|
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4092
        sel := aSpecArray at:i.
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4093
        litVal := aSpecArray at:i + 1.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4094
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4095
        (self respondsTo:sel) ifTrue:[
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4096
            val := litVal decodeAsLiteralArray.
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4097
            self perform:sel with:val
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4098
        ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4099
            Transcript show:self class name; show:': unhandled literalArrayEncoding attribute: '.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4100
            Transcript showCR:sel.
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4101
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4102
            "/ thats a debug halt,
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4103
            "/ it should probably be removed (to simply ignore unhandled attributes)...
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4104
            "/ for now, it is left in, in order to easily find incompatibilities between
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4105
            "/ VW and ST/X.
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4106
            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
  4107
        ]
5755
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4110
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4111
literalArrayEncoding
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4112
    "generate a literalArrayEncoding array for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4113
     This uses #literalArrayEncodingSlotOrder which defines the slots and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4114
     order and #skippedInLiteralEncoding which defines slots to skip.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4115
     For most subclasses, there is no need to redefine those."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4116
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4117
    |names encoding cls skipped slots|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4118
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4119
    self isLiteral ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4120
        ^ self
5755
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
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4123
    slots    := self literalArrayEncodingSlotOrder.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4124
    skipped  := self skippedInLiteralEncoding.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4125
    cls      := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4126
    names    := cls allInstVarNames.
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4127
    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
  4128
    encoding add:cls name.
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4129
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4130
    slots do:[:instSlot |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4131
        |value nm|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4132
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4133
        nm := names at:instSlot.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4134
        (skipped includes:nm) ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4135
            (value := self instVarAt:instSlot) notNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4136
                encoding add:(nm , ':') asSymbol.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4137
                encoding add:value literalArrayEncoding
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4138
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4139
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4140
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4141
    ^ encoding asArray
8841
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4142
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4143
    "
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4144
        (1 -> 2) literalArrayEncoding
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4145
        DebugView menuSpec decodeAsLiteralArray literalArrayEncoding  =
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4146
           DebugView menuSpec
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4147
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4148
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4149
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4150
literalArrayEncodingSlotOrder
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4151
    "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
  4152
     a literalArrayEncoding"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4153
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4154
    ^ 1 to:self class instSize
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
7112
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4157
postDecodeFrom:aDecoder aspect:aspectSymbol
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4158
    "invoked by xmlDecoder (and others in the future), after an
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4159
     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
  4160
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4161
    ^ self
7112
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4162
!
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4163
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4164
skippedInLiteralEncoding
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4165
    "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
  4166
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4170
!Object methodsFor:'error handling'!
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
appropriateDebugger:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4173
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4174
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4175
    "return an appropriate debugger to use.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4176
     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
  4177
     the DebugView, return MiniDebugger (as a last chance) otherwise abort."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4178
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4179
    |context|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4180
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4181
    "DebugView cannot run without system processes"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4182
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4183
    (Processor isNil 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4184
    or:[Processor activeProcessIsSystemProcess
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4185
    or:[Smalltalk isInitialized not]]) ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4186
        ^ MiniDebugger
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4187
    ].
6778
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  4188
    (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
  4189
        Debugger isNil ifTrue:[^ nil].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4190
        ^ MiniDebugger
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4191
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4192
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4193
    context := thisContext.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4194
    context := context findNextContextWithSelector:aSelector or:nil or:nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4195
    [context notNil] whileTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4196
        ((context receiver class == Debugger) 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4197
         and:[context selector == aSelector]) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4198
            "we are already in some Debugger"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4199
            (Debugger == MiniDebugger) ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4200
                "we are already in the MiniDebugger"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4201
                ErrorRecursion ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4202
                    Smalltalk fatalAbort:'recursive error ...'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4203
                ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4204
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4205
            MiniDebugger isNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4206
                Smalltalk fatalAbort:'no debugger'
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4207
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4208
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4209
            "ok, an error occured while in the graphical debugger;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4210
             lets try MiniDebugger"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4211
            ^ MiniDebugger
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4212
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4213
        context := context findNextContextWithSelector:aSelector or:nil or:nil.
5755
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
    "not within Debugger - no problem"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4216
    ^ Debugger
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
    "Modified: / 23.9.1996 / 12:14:52 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4219
    "Modified: / 19.5.1999 / 18:05:00 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4222
cannotSendMessage:aMessage to:someReceiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4223
    "this message is sent by the runtime system (VM),
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4224
     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
  4225
     a valid behavior (see documentation in Behavior)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4226
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4227
    ^ VMInternalError
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4228
          raiseWith:someReceiver
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4229
          errorString:('bad class in send of #' , aMessage selector)
5755
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
    "Modified: 23.1.1997 / 00:05:39 / cg"
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
doesNotUnderstand:aMessage
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4235
    "this message is sent by the runtime system (VM) when
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4236
     a message is not understood by some object (i.e. there
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4237
     is no method for that selector). The original message has
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4238
     been packed into aMessage (i.e. the receiver, selector and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4239
     any arguments) and the original receiver is then sent the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4240
     #doesNotUnderstand: message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4241
     Here, we raise another signal which usually enters the debugger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4242
     You can of course redefine #doesNotUnderstand: in your classes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4243
     to implement message delegation, 
8500
10d47cede03c Speed up MessageNotUnderstood exception sending by layz computation
Stefan Vogel <sv@exept.de>
parents: 8481
diff changeset
  4244
     or handle the MessageNotUnderstood exception gracefully."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4245
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4246
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4247
8500
10d47cede03c Speed up MessageNotUnderstood exception sending by layz computation
Stefan Vogel <sv@exept.de>
parents: 8481
diff changeset
  4248
    ^ MessageNotUnderstood raiseRequestWith:aMessage
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4249
!
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
elementBoundsError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4252
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4253
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4254
    "report an error that badElement is out of bounds 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4255
     (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
  4256
     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
  4257
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4258
    ^ ElementBoundsError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4259
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4260
    "Modified: 8.5.1996 / 09:12:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4261
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4262
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4263
elementBoundsError:aValue
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4264
    "{ Pragma: +optSpace }"
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4265
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4266
    "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
  4267
     (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
  4268
     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
  4269
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4270
    ^ ElementBoundsError raiseWith:aValue
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4271
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4272
    "Modified: 8.5.1996 / 09:12:45 / cg"
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4273
!
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4274
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4275
elementNotCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4276
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4277
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4278
    "report an error that object to be stored is no Character.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4279
     (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
  4280
     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
  4281
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4282
    ^ ElementBoundsError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4283
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4284
    "Modified: 8.5.1996 / 09:12:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4285
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4286
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4287
elementNotInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4288
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4289
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4290
    "report an error that object to be stored is not Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4291
     (in collections that store integers only).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4292
     The error is reported by raising the ElementOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4293
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4294
    ^ ElementBoundsError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4295
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4296
    "Modified: 8.5.1996 / 09:12:51 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4297
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4298
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4299
error
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4300
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4301
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4302
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4303
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4304
    "report error that an error occured.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4305
     The error is reported by raising the Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4306
     which is non-proceedable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4307
     If no handler has been setup, a debugger is entered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4308
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4309
    Error raiseWith:#error:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4310
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4311
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4312
     nil error
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4313
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4314
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4315
    "Modified: / 8.5.1996 / 09:13:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4316
    "Modified: / 2.8.1999 / 17:00:19 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4317
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4318
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4319
error:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4320
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4321
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4322
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4323
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4324
    "Raise an error with error message aString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4325
     The error is reported by raising the Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4326
     which is non-proceedable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4327
     If no handler has been setup, a debugger is entered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4328
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4329
    Error raiseWith:#error: errorString:aString 
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
      nil error:' bad bad bad'
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4335
    "Modified: 8.5.1996 / 09:13:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4336
!
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
error:aString mayProceed:mayProceed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4339
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4340
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4341
    "enter debugger with error-message aString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4342
     The error is reported by raising either the 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4343
     non-proceedable Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4344
     or the ProceedableError exception."
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
    mayProceed ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4347
        ^ ProceedableError raiseRequestWith:#error: errorString:aString 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4348
    ].
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
    Error raiseWith:#error: errorString:aString 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4351
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4352
    "Modified: 8.5.1996 / 09:13:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4353
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4354
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4355
errorInvalidFormat
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4356
    "{ Pragma: +optSpace }"
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4357
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4358
    <context: #return>
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4359
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4360
    "report an error that some conversion to/from string representation failed
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4361
     typically when converting numbers, date, time etc."
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4362
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4363
    ^ ConversionError raiseErrorString:'invalid format'
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4364
!
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4365
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4366
errorKeyNotFound:aKey
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4367
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4368
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4369
    "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
  4370
     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
  4371
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4372
    ^ KeyNotFoundError raiseRequestWith:aKey
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4373
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4374
    "
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4375
     Dictionary new at:#nonExistantElement
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4376
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4377
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4378
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4379
errorNotFound
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4380
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4381
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4382
    "report an error that no element was found in a collection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4383
     The error is reported by raising the NotFoundSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4384
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4385
    ^ NotFoundError raiseRequestWith:nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4386
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4387
    "Modified: / 8.5.1996 / 09:13:11 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4388
    "Modified: / 26.7.1999 / 10:51:50 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4389
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4390
6874
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4391
errorNotFound:errorString
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4392
    "{ Pragma: +optSpace }"
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4393
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4394
    "report an error that no element was found in a collection.
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4395
     The error is reported by raising the NotFoundSignal exception."
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4396
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4397
    ^ NotFoundError raiseErrorString:errorString
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4398
!
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4399
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4400
errorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4401
    ^ self class errorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4402
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4403
    "Created: / 19.6.1998 / 02:32:32 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4404
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4405
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4406
halt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4407
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4408
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4409
    "enter debugger with halt-message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4410
     The error is reported by raising the HaltSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4411
6716
7e2bac4221d1 allow for halts to be ignored
Claus Gittinger <cg@exept.de>
parents: 6708
diff changeset
  4412
    (Smalltalk at:#IgnoreHalt ifAbsent:false) == true ifTrue:[^ self].
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4413
    ^ HaltInterrupt raiseRequestWith:#halt
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4414
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4415
    "Modified: / 2.8.1999 / 17:00:29 / stefan"
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4416
    "Modified: / 17.11.2001 / 22:47:44 / cg"
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4419
halt:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4420
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4421
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4422
    "enter debugger with halt-message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4423
     The error is reported by raising the HaltSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4424
6716
7e2bac4221d1 allow for halts to be ignored
Claus Gittinger <cg@exept.de>
parents: 6708
diff changeset
  4425
    (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
  4426
    ^ HaltInterrupt raiseRequestWith:#halt: errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4427
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4428
    "Modified: 8.5.1996 / 09:13:23 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4429
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4430
7322
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4431
handlerForSignal:exceptionHandler context:theContext originator:originator
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4432
    " 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
  4433
7566
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4434
    thisContext isRecursive ifTrue:[^ nil].
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4435
7322
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4436
    '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
  4437
    '         context: ' print. theContext printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4438
    '         originator: ' print. originator printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4439
    '         sender: ' print. thisContext sender printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4440
7566
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4441
    "/ MiniDebugger enter:thisContext withMessage:'oops' mayProceed:true.
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4442
    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
  4443
!
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4444
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4445
implementedBySubclass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4446
    "{ Pragma: +optSpace }"
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
    "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
  4449
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4450
    ^ self subclassResponsibility:'method must be reimplemented in ST/V subclass'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4451
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4452
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4453
indexNotInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4454
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4455
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4456
    "report an error that index is not an Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4457
     (when accessing collections indexed by an integer key).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4458
     The error is reported by raising the NonIntegerIndexSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4459
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4460
    ^ NonIntegerIndexError raiseRequestWith:nil
5755
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
    "Modified: / 8.5.1996 / 09:13:37 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4463
    "Modified: / 26.7.1999 / 10:57:43 / stefan"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4466
indexNotInteger:anIndex
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4467
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4468
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4469
    "report an error that index is not an Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4470
     (when accessing collections indexed by an integer key).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4471
     The error is reported by raising the NonIntegerIndexSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4472
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4473
    ^ NonIntegerIndexError raiseRequestWith:anIndex 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4474
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4475
    "Created: / 16.5.1998 / 19:39:41 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4476
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4477
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4478
indexNotIntegerOrOutOfBounds:index
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4479
    "{ Pragma: +optSpace }"
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4480
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4481
    "report an error that index is either non-integral or out of bounds"
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4482
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4483
    index isInteger ifFalse:[
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4484
        ^ self indexNotInteger:index
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4485
    ].
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4486
    ^ self subscriptBoundsError:index
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4487
!
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4488
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4489
integerCheckError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4490
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4491
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4492
    "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
  4493
     value assigned"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4494
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4495
    ^ self error:'bad assign of ' , self printString , 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4496
                  ' (' , self class name , ') to integer-typed variable'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4497
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4498
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4499
invalidCodeObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4500
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4501
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4502
    self error:'not an executable code object'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4503
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4504
    "Created: 1.8.1997 / 00:16:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4505
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4506
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4507
invalidMessage 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4508
    "{ Pragma: +optSpace }"
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
    "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
  4511
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4512
    ^ self shouldNotImplement
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4513
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4514
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4515
mustBeRectangle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4516
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4517
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4518
    "report an argument-not-rectangle-error"
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
    ^ self error:'argument must be a Rectangle'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4521
!
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
mustBeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4524
    "{ Pragma: +optSpace }"
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
    "report an argument-not-string-error"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4527
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4528
    ^ self error:'argument must be a String'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4529
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4530
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4531
notIndexed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4532
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4533
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4534
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4535
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4536
    "report an error that receiver has no indexed instance variables.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4537
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4538
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4539
    ^ SubscriptOutOfBoundsError 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4540
        raiseErrorString:'receiver has no indexed variables'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4541
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4542
    "Modified: 26.7.1996 / 16:43:13 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4543
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4544
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4545
openDebuggerOnException:ex
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4546
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4547
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4548
    "enter the debugger on some unhandled exception"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4549
6884
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4550
    |msgString debugger answer|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4551
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4552
    msgString := ex description.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4553
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4554
     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
  4555
     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
  4556
     ignore will raise an AbortOperationRequest.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4557
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4558
    Debugger isNil ifTrue:[
6840
073cdeca1681 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6829
diff changeset
  4559
        msgString := 'Error: ' , msgString.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4560
7562
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4561
        thisContext isRecursive ifTrue:[
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4562
            msgString errorPrintCR.
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4563
            Smalltalk fatalAbort:'recursive unhandled exception'
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4564
        ].
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4565
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4566
        Smalltalk isStandAloneApp ifTrue:[
9297
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4567
            ex parameter signal == HaltInterrupt ifTrue:[
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4568
                "/ 'Halt ignored' infoPrintCR.
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4569
                ^ self
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4570
            ].
de57e4607c5b halt in standAlone app.
Claus Gittinger <cg@exept.de>
parents: 9293
diff changeset
  4571
7562
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4572
            (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
  4573
                AbortOperationRequest isHandled ifTrue:[
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4574
                    answer := OptionBox
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4575
                            request:msgString
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4576
                            label:msgString
9299
f5fe49cd9bcc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9298
diff changeset
  4577
                            buttonLabels:#('Exit' 'Terminate Thread' 'Ignore' 'Abort' )
f5fe49cd9bcc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9298
diff changeset
  4578
                            values:#(exit terminate ignore abort)
9298
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4579
                            default:#abort.
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4580
                ] ifFalse:[
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4581
                    answer := OptionBox
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4582
                            request:msgString
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4583
                            label:msgString
9299
f5fe49cd9bcc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9298
diff changeset
  4584
                            buttonLabels:#('Exit' 'Terminate Thread' 'Ignore' )
f5fe49cd9bcc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9298
diff changeset
  4585
                            values:#(exit terminate ignore )
9298
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4586
                            default:#terminate.
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4587
                ].
7562
869c48046a5c oops - standAlone debugging fixed
Claus Gittinger <cg@exept.de>
parents: 7539
diff changeset
  4588
6884
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4589
                answer == #abort ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4590
                    ^ AbortOperationRequest raiseRequest
6884
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4591
                ].
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  4592
                answer == #ignore ifTrue:[
6884
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4593
                    ^ nil
de5e191dbfaf more standAlone support
Claus Gittinger <cg@exept.de>
parents: 6877
diff changeset
  4594
                ].
9298
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4595
                answer == #terminate ifTrue:[
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4596
                    ^ Processor activeProcess terminate.
2629011bf060 added terminate to unhandled exception dialog
Claus Gittinger <cg@exept.de>
parents: 9297
diff changeset
  4597
                ].
9314
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4598
                "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
  4599
                answer == #exit ifTrue:[
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4600
                    answer := OptionBox
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4601
                            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
  4602
                            label:msgString
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4603
                            buttonLabels:#('Yes' 'No' )
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4604
                            values:#(exit abort)
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4605
                            default:#abort.
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4606
                ].
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4607
                answer == #abort ifTrue:[
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4608
                    ^ AbortOperationRequest raiseRequest
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4609
                ].
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4610
93bac344273f asking twice to exit applicaion after unhandled exception (only standalone app)
Michael Beyl <mb@exept.de>
parents: 9299
diff changeset
  4611
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4612
            ].
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4613
            "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
  4614
            ex signal == NoHandlerError ifTrue:[
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4615
                ex parameter signal == UserInterrupt ifTrue:[
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4616
                    OperatingSystem exit:130
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4617
                ].
bc8e45d10f43 dont out the "unhandled exception..." message,
Claus Gittinger <cg@exept.de>
parents: 6840
diff changeset
  4618
            ].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4619
            msgString errorPrintCR.
9203
9bd6647d1c63 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9146
diff changeset
  4620
            thisContext fullPrintAll.    
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4621
            OperatingSystem exit:1
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4622
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4623
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4624
        msgString errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4625
        Smalltalk fatalAbort:'no Debugger defined'
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4628
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4629
     find an appropriate debugger to use
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4630
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4631
    debugger := self appropriateDebugger:(thisContext selector).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4632
    debugger isNil ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4633
        ^ AbortOperationRequest raiseRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4634
    ].    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4635
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4636
    ^ debugger 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4637
        enter:ex suspendedContext
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4638
        withMessage:msgString 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4639
        mayProceed:(ex mayProceed).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4640
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4641
    "Modified: 24.7.1997 / 10:09:20 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4642
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4643
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4644
primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4645
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4646
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4647
    "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
  4648
     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
  4649
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4650
    |sender|
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4651
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4652
    sender := thisContext sender.
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4653
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4654
    ^ 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
  4655
                       in:sender.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4656
6005
012813d02bf7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6000
diff changeset
  4657
    "
012813d02bf7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6000
diff changeset
  4658
     1234 primitiveFailed
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4659
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4660
     [
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4661
        ExternalBytes new   basicAt:40
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4662
     ] on:PrimitiveFailure do:[:ex|
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4663
        ex inspect
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4664
     ]
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4665
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4666
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4667
8977
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4668
primitiveFailed:messageString
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4669
    "{ Pragma: +optSpace }"
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4670
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4671
    "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
  4672
     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
  4673
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4674
    |sender|
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4675
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4676
    sender := thisContext sender.
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4677
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4678
    ^ 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
  4679
                       errorString:messageString 
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4680
                       in:sender.
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4681
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4682
    "
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4683
     1234 primitiveFailed:'this is a test'
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4684
    "
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4685
!
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4686
6815
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4687
shouldImplement
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4688
    "{ Pragma: +optSpace }"
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4689
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4690
    "report an error that this message should be implemented.
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4691
     This is send by automatically generated method bodies"
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4692
9216
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4693
    |sender|
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4694
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4695
    sender := thisContext sender.
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4696
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4697
    ^ UnimplementedFunctionalityError raiseRequestWith:(Message selector:sender selector arguments:sender args)
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4698
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4699
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4700
     "
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4701
        self shouldImplement
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4702
     "
6815
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4703
!
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4704
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4705
shouldNotImplement
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4706
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4708
    "report an error that this message should not be implemented"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4709
8729
2e454c09b38a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8690
diff changeset
  4710
    ^ self error:'method/functionality not appropriate for this class'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4711
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4712
    "Modified: 8.5.1996 / 09:09:44 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4715
subclassResponsibility
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4716
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4717
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4718
    "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
  4719
     subclass"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4720
7334
7da368a2f0da *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7322
diff changeset
  4721
    ^ SubclassResponsibilityError raiseRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4722
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4723
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4724
subclassResponsibility:msg
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4725
    "{ Pragma: +optSpace }"
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4726
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4727
    "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
  4728
7334
7da368a2f0da *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7322
diff changeset
  4729
    ^ SubclassResponsibilityError raiseRequestErrorString:msg
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4730
!
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4731
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4732
subscriptBoundsError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4733
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4734
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4735
    "report an error that some index is out of bounds.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4736
     (when accessing indexable collections).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4737
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4738
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4739
    ^ SubscriptOutOfBoundsSignal raiseRequestWith:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4740
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4741
    "Modified: / 26.7.1996 / 16:45:42 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4742
    "Modified: / 26.7.1999 / 10:58:27 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4743
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4744
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4745
subscriptBoundsError:anIndex
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4746
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4747
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4748
    "report an error that anIndex is out of bounds.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4749
     (when accessing indexable collections).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4750
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4751
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4752
    ^ SubscriptOutOfBoundsError 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4753
        raiseRequestWith:anIndex 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4754
        errorString:('subscript (' , anIndex printString , ') out of bounds')
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4755
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4756
    "Modified: / 17.11.2001 / 22:49:56 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4757
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4758
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4759
typeCheckError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4760
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4761
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4762
    "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
  4763
     value assigned"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4764
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4765
    ^ self error:'bad assign of ' , self printString ,
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4766
                  ' (' , self class name , ') to typed variable'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4767
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4768
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4769
!Object methodsFor:'evaluation'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4770
8690
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4771
argumentCount
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4772
    "compatibility with Blocks and Messages.
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4773
     Answer 0, since we only understand #value.
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4774
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4775
     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
  4776
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4777
    ^ 0
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4778
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4779
    "
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4780
        [1 // 0] on:ArithmeticError do:9999
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4781
    "
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4782
!
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4783
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4784
value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4785
    "return the receiver itself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4786
     This allows every object to be used where blocks or valueHolders
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4787
     are typically used, and allows for valueHolders and blocks to be
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4788
     used interchangably in some situations.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4789
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4790
     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
  4791
     style ... (the idea was borrowed from the Self language).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4792
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4793
     WARNING: dont 'optimize' away ifXXX: blocks 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4794
              (i.e. do NOT replace 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4795
                        foo ifTrue:[var1] ifFalse:[var2]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4796
               by:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4797
                        foo ifTrue:var1 ifFalse:var2
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4798
              )
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4799
              - the compilers will only generate inline code for the if, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4800
                iff the argument(s) are blocks - otherwise, a true send is
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4801
                generated.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4802
              This 'oprimization' will work semantically correct,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4803
              but execute SLOWER instead."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4804
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4805
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4806
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4807
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4808
     #(1 2 3 4) indexOf:5 ifAbsent:0     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4809
     #(1 2 3 4) indexOf:5 ifAbsent:[0]     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4810
     1 > 2 ifTrue:['yes'] ifFalse:['no']  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4811
     1 > 2 ifTrue:'yes' ifFalse:'no'       
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4812
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4813
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4814
    "DO NOT DO THIS (its slower)
7458
b0ca7546cbd6 CG: comment in value
Stefan Vogel <sv@exept.de>
parents: 7455
diff changeset
  4815
     (1 > 4) ifTrue:a ifFalse:b
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4816
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4817
     USE (the compiler optimizes blocks in if/while):
7458
b0ca7546cbd6 CG: comment in value
Stefan Vogel <sv@exept.de>
parents: 7455
diff changeset
  4818
     (1 > 4) ifTrue:[a] ifFalse:[b]
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4821
    "Modified: 3.5.1996 / 11:57:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4822
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4823
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4824
!Object methodsFor:'finalization'!
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
disposed
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4827
    "OBSOLETE INTERFACE: use #finalize
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4828
     this is invoked for objects which have been registered
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4829
     in a Registry, when the original object dies.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4830
     Subclasses may redefine this method"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4831
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4832
    <resource: #obsolete>
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4833
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4834
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4835
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4836
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4837
executor
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4838
    "Return the object which does the finalization for me.
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4839
     This interface is also VW & Sqeak compatible,"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4840
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4841
    "for now, send #shallowCopyForFinalization, to be compatible with
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4842
     classes designed for old ST/X versions"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4843
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4844
    ^ self shallowCopyForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4845
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4846
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4847
finalizationLobby
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4848
    "answer a Registry used for finalization.
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4849
     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
  4850
     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
  4851
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4852
    ^ FinalizationLobby
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4853
!
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4854
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4855
finalize
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4856
    "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
  4857
     in a Registry, when the original object dies.
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4858
     Subclasses may redefine this method
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4859
     This interface is also VW-compatible"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4860
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4861
    "send #disposed for compatibility with existing classes that still
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4862
     implement the obsolete #disposed message"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4863
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4864
    ^ self disposed
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4865
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4866
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4867
reRegisterForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4868
    "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
  4869
     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
  4870
     the receiver is garbage collected."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4871
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4872
    self finalizationLobby registerChange:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4873
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4874
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4875
registerForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4876
    "register mySelf for later finalization.
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4877
     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
  4878
     the receiver is garbage collected."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4879
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4880
    self finalizationLobby register:self
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4881
!
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4882
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4883
shallowCopyForFinalization
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4884
    "OBSOLETE INTERFACE: use #executor.
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4885
     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
  4886
     (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
  4887
     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
  4888
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4889
    <resource: #obsolete>
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4890
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4891
    ^ self shallowCopy
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4892
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4893
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4894
unregisterForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4895
    "unregister mySelf from later finalization"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4896
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4897
    self finalizationLobby unregister:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4898
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4899
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4900
!Object methodsFor:'initialization'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4901
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4902
initialize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4903
    "just to ignore initialize to objects which do not need it"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4904
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4905
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4906
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4907
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4908
!Object methodsFor:'interrupt handling'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4909
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4910
childSignalInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4911
    "death of a child process (unix process) - do nothing"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4912
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4913
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4914
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4915
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4916
customInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4917
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4918
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4919
    "a custom interrupt - but no handler has defined"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4920
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4921
    self error:'custom interrupt' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4922
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4923
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4924
errorInterrupt:errorID with:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4925
    "subsystem error. The arguments errorID and aParameter are the values passed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4926
     to the 'errorInterruptWithIDAndParameter(id, param)' function, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4927
     which can be called from C subsystems to raise an (asynchronous)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4928
     error exception.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4929
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4930
     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
  4931
     used from other C subsystems too, to upcast errors.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4932
     Especially, for subsystems which call errorHandler functions asynchronously.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4933
     IDs (currently) used:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4934
        #DisplayError ..... x-error interrupt
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4935
        #XtError      ..... xt-error interrupt (Xt interface is not yet published)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4936
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4937
6263
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  4938
    |handlers handler|
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  4939
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  4940
    handlers := ObjectMemory registeredErrorInterruptHandlers.
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  4941
    handlers notNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4942
        handler := handlers at:errorID ifAbsent:nil.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4943
        handler notNil ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4944
            "/
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4945
            "/ handler found; let it do whatever it wants ...
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4946
            "/
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4947
            handler errorInterrupt:errorID with:aParameter.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4948
            ^ self
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4949
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4950
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4951
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4952
    "/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4953
    "/ no handler - raise errorSignal passing the errorId as parameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4954
    "/
7094
617eeaf2f8ba Convert Object>>errorSignal -> Error
Stefan Vogel <sv@exept.de>
parents: 7081
diff changeset
  4955
    ^ Error 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4956
        raiseRequestWith:errorID 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4957
        errorString:('Subsystem error. ErrorID = ' , errorID printString)
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
exceptionInterrupt
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
    "exception interrupt - 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:'exception Interrupt' 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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4968
fpExceptionInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4969
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4970
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4971
    "a floating point exception occured - this one
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4972
     has to be handled differently since it comes asynchronous
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4973
     on some machines (for example, on machines with a separate FPU
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4974
     or superscalar architectures. Also, errors from within primitive code
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4975
     (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
  4976
     mechanism this way."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4977
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4978
    |where rec|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4979
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4980
    where := thisContext sender.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4981
    rec := where receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4982
    rec isNumber ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4983
        ^ rec class
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4984
            raise:#domainErrorSignal
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4985
            receiver:rec
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4986
            selector:where selector
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4987
            arguments:(where args asArray)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  4988
            errorString:'floating point exception'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4989
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4990
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4991
    "/ could be in some C-library ...
7402
b9d45ce2463a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7359
diff changeset
  4992
    ^ DomainError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4993
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4994
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4995
internalError:msg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4996
    "{ Pragma: +optSpace }"
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
    "this is triggered, when VM hits some bad error,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4999
     such as corrupted class, corrupted method/selector array
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5000
     etc. The argument string gives some more information on what happened.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5001
     (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
  5002
     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
  5003
     this error occurred ...."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5004
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  5005
    VMInternalError raiseWith:self errorString:msg
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5006
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5007
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5008
ioInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5009
    "{ Pragma: +optSpace }"
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
    "I/O (SIGIO/SIGPOLL) interrupt (supposed to be sent to Processor).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5012
     If we arrive here, there is either no handler (ObjMem>>ioInterruptHandler)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5013
     or it does not understand the ioInterrupt message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5014
     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
  5015
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5016
    self error:'I/O Interrupt - but no handler' mayProceed:true
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5019
memoryInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5020
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5021
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5022
    "out-of-memory interrupt and no handler - enter debugger"
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
    self error:'almost out of memory' mayProceed:true
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5027
recursionInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5028
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5029
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5030
    "recursion limit (actually: stack overflow) interrupt.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5031
     This interrupt is triggered, when a process stack grows above
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5032
     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
  5033
     could be caught.
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  5034
     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
  5035
     and the exception can be resumed.
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  5036
     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
  5037
     is not proceedable.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5038
     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
  5039
     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
  5040
     or debug for a while.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5041
     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
  5042
     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
  5043
     terminates the process."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5044
7838
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5045
    |con remaining sender nSkipped|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5046
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5047
    (con := thisContext) isRecursive ifFalse:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5048
"/        Processor activeProcess usedStackSize < Processor activeProcess maximumStackSize ifTrue:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5049
"/            "/ mhmh - it hit me, but I am not responsible ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5050
"/            'Stray recursionInterrupt ...' infoPrintCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5051
"/            ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5052
"/        ].
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5053
        ObjectMemory infoPrinting ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5054
            'Object [info]: recursionInterrupt from:' printCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5055
            con := con sender.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5056
            remaining := 50.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5057
            [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
  5058
                sender := con sender.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5059
                '| ' print. con fullPrint.
7838
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5060
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5061
                nSkipped := 0.    
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5062
                [sender notNil and:[sender sender notNil 
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5063
                and:[sender selector == con selector
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5064
                and:[sender sender selector == con selector
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5065
                and:[sender method == con method]]]]] whileTrue:[
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5066
                    nSkipped := nSkipped + 1.    
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5067
                    con := sender.
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5068
                    sender := con sender.
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5069
                ].
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5070
                nSkipped > 0 ifTrue:[
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5071
                    '| ... ***** ' 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
  5072
                ].
4cf3d0dad430 skip recursive contexts when shwing backtrace of recursionInterrupt
Claus Gittinger <cg@exept.de>
parents: 7685
diff changeset
  5073
                con := sender.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5074
                remaining := remaining - 1
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5075
            ].
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
        ^ RecursionInterruptSignal raiseSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5078
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5079
6175
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  5080
    "Modified: / 10.11.2001 / 15:15:56 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5081
!
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
schedulerInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5084
    "{ Pragma: +optSpace }"
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
    "scheduler interrupt (supposed to be sent to Processor).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5087
     If we arrive here, either the Processor does not understand it,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5088
     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
  5089
     big trouble. Enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5090
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5091
    self error:'schedulerInterrupt - but no Processor' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5092
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5093
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5094
signalInterrupt:signalNumber
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5095
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5096
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5097
    "unix signal occured - some signals are handled as Smalltalk Exceptions 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5098
     (SIGPIPE), others (SIGBUS) are rather fatal ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5099
     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
  5100
     that one is raised.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5101
     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
  5102
     signal.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5103
     TODO: add another argument, giving more detailed signal info (PC, VADDR,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5104
     exact cause etc.). This helps if segvs occur in primitive code.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5105
     Currently (temporary kludge), these are passed as global variables."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5106
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5107
    |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
  5108
     action title screen|
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5109
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5110
    "if there has been an ST-signal installed, use it ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5111
    sig := OperatingSystem operatingSystemSignal:signalNumber.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5112
    sig notNil ifTrue:[
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  5113
        sig raiseSignalWith:signalNumber.
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5114
        ^ self.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5115
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5116
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5117
    "/ if handled, raise OSSignalInterruptSignal
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  5118
    OSSignalInterrupt isHandled ifTrue:[
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  5119
        OSSignalInterrupt raiseRequestWith:signalNumber.
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5120
        ^ self.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5121
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5122
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5123
    "
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  5124
     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
  5125
                  - SIGHUP: hang up - write a crash image and exit
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5126
    "
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5127
    signalNumber == 30 "OperatingSystem sigPWR"  ifTrue:[
8806
03e74cded971 Make snapshot writing more robust against errors.
Stefan Vogel <sv@exept.de>
parents: 8798
diff changeset
  5128
        [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
  5129
        ^ self.
5856
6d3df9ad361e save crash image when sigPWR or sigHUP arrives
Claus Gittinger <cg@exept.de>
parents: 5824
diff changeset
  5130
    ].
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5131
    (signalNumber == 1 "OperatingSystem sigHUP") ifTrue:[
8806
03e74cded971 Make snapshot writing more robust against errors.
Stefan Vogel <sv@exept.de>
parents: 8798
diff changeset
  5132
        [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
  5133
        Smalltalk exit:1.
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5134
    ].
5856
6d3df9ad361e save crash image when sigPWR or sigHUP arrives
Claus Gittinger <cg@exept.de>
parents: 5824
diff changeset
  5135
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5136
    name := OperatingSystem nameForSignal:signalNumber.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5137
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5138
    "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
  5139
    (Screen isNil 
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5140
     or:[(screen := Screen current) isNil
6778
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  5141
     or:[(screen := Screen default) isNil
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  5142
     or:[screen isOpen not]]]) ifTrue:[
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  5143
        ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5144
    ].
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5145
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5146
    "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
  5147
     otherwise display stays locked"
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5148
    screen ungrabPointer; ungrabKeyboard.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5149
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5150
    here := thisContext.
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5151
    badContext := here sender.          "the context, in which the signal occurred"
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5152
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5153
    "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
  5154
    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
  5155
        "
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5156
         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
  5157
         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
  5158
         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
  5159
        "
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5160
        fatal := OperatingSystem isFatalSignal:signalNumber.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5161
        fatal ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5162
            (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
  5163
                'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR.
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  5164
                ^ 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
  5165
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5166
            "
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5167
             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
  5168
            "
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5169
            msg := 'OS-signal: ', name.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5170
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5171
            "/ 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
  5172
            "/ 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
  5173
            "/ 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
  5174
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5175
            InterruptPcLow notNil ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5176
                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
  5177
                pc ~~ 0 ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5178
                    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
  5179
                ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5180
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5181
            InterruptAddrLow notNil ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5182
                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
  5183
                addr ~~ 0 ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5184
                    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
  5185
                ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5186
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5187
            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
  5188
            "unreachable"
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5189
            ^ nil.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5190
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5191
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5192
        "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
  5193
         Otherwise, start a debugger"
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5194
        Dialog notNil ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5195
            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
  5196
            actions := #(save core exit debug).
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5197
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5198
            action := nil.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5199
            title := 'OS Signal caught (' , name, ')'.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5200
            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
  5201
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5202
            "/ 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
  5203
            "/ 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
  5204
            "/ (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
  5205
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5206
            Processor activeProcess isSystemProcess ifFalse:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5207
                titles := #('abort') , titles.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5208
                actions := #(abort), actions. 
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5209
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5210
                badContext canReturn ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5211
                    titles := #('return') , titles.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5212
                    actions :=  #(return), actions.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5213
                ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5214
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5215
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5216
            fatal ifFalse:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5217
                titles := titles, #('ignore').
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5218
                actions := actions , #(ignore).
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5219
            ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5220
            action := Dialog choose:title
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5221
                             labels:titles
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5222
                             values:actions
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5223
                             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
  5224
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5225
            "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
  5226
            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
  5227
        ] ifFalse:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5228
            action := #debug.
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5229
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5230
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5231
        action == #save ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5232
            ObjectMemory snapShotOn:'crash.img'
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5233
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5234
        action == #core ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5235
            Smalltalk fatalAbort
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5236
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5237
        action == #exit ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5238
            Smalltalk exit
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5239
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5240
        action == #return ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5241
            badContext return
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5242
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5243
        action == #abort ifTrue:[
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  5244
            AbortOperationRequest raise.
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5245
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5246
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5247
        action == #debug ifTrue:[
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5248
            Debugger isNil ifTrue:[
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  5249
                ^ 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
  5250
            ].
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  5251
            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
  5252
        ].
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5253
        "action == #ignore"
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5254
    ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5255
!
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
spyInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5258
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5259
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5260
    "spy interrupt and no handler - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5261
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5262
    self error:'spy Interrupt - but no handler' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5263
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5264
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5265
startMiniDebuggerOrExit:text
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5266
    "some critical condition happened.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5267
     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
  5268
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5269
    MiniDebugger isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5270
        "a system without debugging facilities (i.e. a standalone system)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5271
         output a message and exit."
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5272
        ('Object [error]: exit due to ', text, ' - and no debugger.') errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5273
        OperatingSystem exit:99.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5274
    ].
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5275
    MiniDebugger enterWithMessage:text mayProceed:true.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5276
!
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5277
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5278
timerInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5279
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5280
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5281
    "timer interrupt and no handler - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5282
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5283
    self error:'timer Interrupt - but no handler' mayProceed:true
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5286
userInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5287
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5288
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5289
    "user (^c) interrupt.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5290
     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
  5291
     controlling tty (i.e. in the xterm)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5292
6466
ae28dd895a58 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6461
diff changeset
  5293
    UserInterruptSignal raiseRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5294
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5295
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5296
userInterruptIn:aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5297
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5298
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5299
    "user (^c) interrupt - enter debugger, but show aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5300
     as top-context. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5301
     This is used to hide any intermediate scheduler contexts, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5302
     in case of an interrupted process. Typically, this is sent by
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5303
     the WindowGroup, when a keyboardEvent for the ctrl-C key is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5304
     processed."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5305
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5306
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5307
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5308
    UserInterruptSignal raiseRequestWith:nil errorString:nil in:aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5309
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5310
    "Created: / 18.10.1996 / 20:46:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5311
    "Modified: / 20.10.1996 / 13:06:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5312
    "Modified: / 26.7.1999 / 10:58:49 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5313
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5314
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5315
!Object methodsFor:'message sending'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5316
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5317
perform:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5318
    "send the message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5319
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5320
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5321
    REGISTER OBJ sel = aSelector;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5322
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5323
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5324
        struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5325
        static struct inlineCache ilc_0 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5326
        static struct inlineCache ilc_1 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5327
        static struct inlineCache ilc_2 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5328
        static struct inlineCache ilc_3 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5329
        static struct inlineCache ilc_4 = __ILCPERF0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5330
        static OBJ last_0 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5331
        static OBJ last_1 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5332
        static OBJ last_2 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5333
        static OBJ last_3 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5334
        static OBJ last_4 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5335
        static flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5336
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5337
        if (sel == last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5338
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5339
        } else if (sel == last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5340
            pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5341
        } else if (sel == last_2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5342
            pIlc = &ilc_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5343
        } else if (sel == last_3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5344
            pIlc = &ilc_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5345
        } else if (sel == last_4) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5346
            pIlc = &ilc_4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5347
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5348
            if (flip == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5349
                pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5350
                flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5351
                last_0 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5352
            } else if (flip == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5353
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5354
                flip = 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5355
                last_1 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5356
            } else if (flip == 2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5357
                pIlc = &ilc_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5358
                flip = 3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5359
                last_2 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5360
            } else if (flip == 3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5361
                pIlc = &ilc_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5362
                flip = 4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5363
                last_3 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5364
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5365
                pIlc = &ilc_4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5366
                flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5367
                last_4 = sel;
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
            pIlc->ilc_func = __SEND0ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5370
            if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5371
                __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5372
                pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5373
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5374
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5375
        RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5376
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5377
        static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5378
        RETURN (_SEND0(self, aSelector, nil, &ilc0));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5379
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5380
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5381
    ^ self perform:aSelector withArguments:#()
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5382
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5383
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5384
perform:aSelector inClass:aClass withArguments:argArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5385
    "send the message aSelector with all args taken from argArray 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5386
     to the receiver as a super-send message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5387
     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
  5388
     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
  5389
     immediate superclass).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5390
     Thus, it is (theoretically) possible to do 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5391
         '5 perform:#< inClass:Magnitude withArguments:#(6)'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5392
     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
  5393
     This method is used by the interpreter to evaluate super sends
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5394
     and could be used for very special behavior (language extension ?).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5395
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5396
     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
  5397
5769
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5398
    |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
  5399
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5400
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5401
     check, if aClass is really a superclass of the receiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5402
    "
5769
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5403
    myClass := self class.
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5404
    (myClass == aClass or:[myClass isSubclassOf:aClass]) ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5405
        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
  5406
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5407
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5408
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5409
    REGISTER OBJ *argP;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5410
    int nargs, i;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5411
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  5412
    if (__isArrayLike(argArray)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5413
        nargs = __arraySize(argArray);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5414
        argP = __arrayVal(argArray);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5415
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5416
        if (__isNonNilObject(argArray)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5417
            static struct inlineCache ilcSize = __ILC0(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5418
            numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize); 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5419
            if (!__isSmallInteger(numberOfArgs)) 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5420
                goto bad;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5421
            nargs = __intVal(numberOfArgs);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5422
            argP = (OBJ *)(&a1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5423
            for (i=1; i <= nargs; i++) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  5424
                *argP++ = __AT_(argArray, __mkSmallInteger(i));
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5425
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5426
            argP = (OBJ *)(&a1);
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
            nargs = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5429
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5430
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5431
    switch (nargs) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5432
        case 0:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5433
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5434
                static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5435
                RETURN ( _SEND0(self, aSelector, aClass, &ilc0));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5436
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5437
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5438
        case 1: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5439
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5440
                static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5441
                RETURN ( _SEND1(self, aSelector, aClass, &ilc1, argP[0]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5442
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5443
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5444
        case 2: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5445
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5446
                static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5447
                RETURN ( _SEND2(self, aSelector, aClass, &ilc2, argP[0], argP[1]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5448
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5449
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5450
        case 3: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5451
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5452
                static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5453
                RETURN ( _SEND3(self, aSelector, aClass, &ilc3, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5454
                                argP[0], argP[1], argP[2]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5455
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5456
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5457
        case 4: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5458
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5459
                static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5460
                RETURN ( _SEND4(self, aSelector, aClass, &ilc4,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5461
                                argP[0], argP[1], argP[2], argP[3]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5462
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5463
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5464
        case 5: 
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
                static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5467
                RETURN ( _SEND5(self, aSelector, aClass, &ilc5, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5468
                                argP[0], argP[1], argP[2], argP[3], argP[4]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5469
            }
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
        case 6: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5472
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5473
                static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5474
                RETURN ( _SEND6(self, aSelector, aClass, &ilc6, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5475
                                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
  5476
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5477
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5478
        case 7: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5479
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5480
                static struct inlineCache ilc7 = __DUMMYILCSELF7(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5481
                RETURN ( _SEND7(self, aSelector, aClass, &ilc7, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5482
                                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
  5483
                                argP[6]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5484
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5485
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5486
        case 8: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5487
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5488
                static struct inlineCache ilc8 = __DUMMYILCSELF8(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5489
                RETURN ( _SEND8(self, aSelector, aClass, &ilc8, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5490
                                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
  5491
                                argP[6], argP[7]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5492
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5493
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5494
        case 9: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5495
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5496
                static struct inlineCache ilc9 = __DUMMYILCSELF9(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5497
                RETURN ( _SEND9(self, aSelector, aClass, &ilc9, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5498
                                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
  5499
                                argP[6], argP[7], argP[8]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5500
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5501
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5502
        case 10: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5503
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5504
                static struct inlineCache ilc10 = __DUMMYILCSELF10(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5505
                RETURN ( _SEND10(self, aSelector, aClass, &ilc10, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5506
                                 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
  5507
                                 argP[6], argP[7], argP[8], argP[9]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5508
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5509
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5510
        case 11: 
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
                static struct inlineCache ilc11 = __DUMMYILCSELF11(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5513
                RETURN ( _SEND11(self, aSelector, aClass, &ilc11, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5514
                                 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
  5515
                                 argP[6], argP[7], argP[8], argP[9], argP[10]));
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
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5518
        case 12: 
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
                static struct inlineCache ilc12 = __DUMMYILCSELF12(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5521
                RETURN ( _SEND12(self, aSelector, aClass, &ilc12, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5522
                                 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
  5523
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5524
                                 argP[11]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5525
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5526
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5527
        case 13: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5528
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5529
                static struct inlineCache ilc13 = __DUMMYILCSELF13(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5530
                RETURN ( _SEND13(self, aSelector, aClass, &ilc13, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5531
                                 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
  5532
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5533
                                 argP[11], argP[12]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5534
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5535
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5536
        case 14: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5537
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5538
                static struct inlineCache ilc14 = __DUMMYILCSELF14(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5539
                RETURN ( _SEND14(self, aSelector, aClass, &ilc14, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5540
                                 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
  5541
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5542
                                 argP[11], argP[12], argP[13]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5543
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5544
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5545
        case 15: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5546
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5547
                static struct inlineCache ilc15 = __DUMMYILCSELF15(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5548
                RETURN ( _SEND15(self, aSelector, aClass, &ilc15, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5549
                                 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
  5550
                                 argP[6], argP[7], argP[8], argP[9], argP[10], 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5551
                                 argP[11], argP[12], argP[13], argP[14]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5552
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5553
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5554
#ifdef _SEND16
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5555
        case 16:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5556
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5557
                static struct inlineCache ilc16 = __DUMMYILCSELF16(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5558
                RETURN ( _SEND16(self, aSelector, aClass, &ilc15,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5559
                                 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
  5560
                                 argP[6], argP[7], argP[8], argP[9], argP[10],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5561
                                 argP[11], argP[12], argP[13], argP[14], argP[15]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5562
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5563
#endif
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5564
#ifdef _SEND17
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5565
        case 17:
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
                static struct inlineCache ilc17 = __DUMMYILCSELF17(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5568
                RETURN ( _SEND17(self, aSelector, aClass, &ilc15,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5569
                                 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
  5570
                                 argP[6], argP[7], argP[8], argP[9], argP[10],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5571
                                 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
  5572
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5573
#endif
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5574
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5575
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5576
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5577
bad:;
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
    "/ arrive here, if bad number of arguments (too many)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5580
    "/ ST/X (currently) only allows up to 15 method arguments
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
    ^ self primitiveFailed
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5585
perform:aSelector with:arg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5586
    "send the one-arg-message aSelector 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
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5589
    REGISTER OBJ sel = aSelector;
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
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5592
        struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5593
        static struct inlineCache ilc_0 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5594
        static struct inlineCache ilc_1 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5595
        static struct inlineCache ilc_2 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5596
        static struct inlineCache ilc_3 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5597
        static struct inlineCache ilc_4 = __ILCPERF1(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5598
        static OBJ last_0 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5599
        static OBJ last_1 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5600
        static OBJ last_2 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5601
        static OBJ last_3 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5602
        static OBJ last_4 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5603
        static flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5604
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5605
        if (sel == last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5606
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5607
        } else if (sel == last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5608
            pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5609
        } else if (sel == last_2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5610
            pIlc = &ilc_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5611
        } else if (sel == last_3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5612
            pIlc = &ilc_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5613
        } else if (sel == last_4) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5614
            pIlc = &ilc_4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5615
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5616
            if (flip == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5617
                pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5618
                flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5619
                last_0 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5620
            } else if (flip == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5621
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5622
                flip = 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5623
                last_1 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5624
            } else if (flip == 2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5625
                pIlc = &ilc_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5626
                flip = 3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5627
                last_2 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5628
            } else if (flip == 3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5629
                pIlc = &ilc_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5630
                flip = 4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5631
                last_3 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5632
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5633
                pIlc = &ilc_4;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5634
                flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5635
                last_4 = sel;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5636
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5637
            pIlc->ilc_func = __SEND1ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5638
            if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5639
                __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5640
                pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5641
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5642
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5643
        RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5644
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5645
        static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5646
        RETURN (_SEND1(self, aSelector, nil, &ilc1, arg));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5647
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5648
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5649
    ^ self perform:aSelector withArguments:(Array with:arg)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5650
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5651
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5652
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5653
perform:aSelector with:arg1 with:arg2
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5654
    "send the two-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5655
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5656
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5657
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5658
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5659
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5660
        static struct inlineCache ilc_0 = __ILCPERF2(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5661
        static struct inlineCache ilc_1 = __ILCPERF2(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5662
        static OBJ last_0 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5663
        static OBJ last_1 = nil;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5664
        static flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5665
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5666
        if (aSelector == last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5667
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5668
        } else if (aSelector == last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5669
            pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5670
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5671
            if (flip == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5672
                pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5673
                flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5674
                last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5675
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5676
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5677
                flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5678
                last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5679
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5680
            pIlc->ilc_func = __SEND2ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5681
            if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5682
                __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5683
                pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5684
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5685
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5686
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5687
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5688
        static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5689
        RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5690
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5691
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5692
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5693
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5694
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5695
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5696
perform:aSelector with:arg1 with:arg2 with:arg3
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5697
    "send the three-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5698
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5699
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5700
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5701
    static struct inlineCache ilc_0 = __ILCPERF3(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5702
    static struct inlineCache ilc_1 = __ILCPERF3(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5703
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5704
    static OBJ last_1 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5705
    static flip = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5706
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5707
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5708
        if (aSelector != last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5709
            if (aSelector != last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5710
                if (flip) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5711
                    pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5712
                    flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5713
                    last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5714
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5715
                    pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5716
                    flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5717
                    last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5718
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5719
                pIlc->ilc_func = __SEND3ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5720
                if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5721
                    __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5722
                    pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5723
                }
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
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5726
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5727
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5728
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5729
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5730
        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
  5731
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5732
        static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5733
        RETURN (_SEND3(self, aSelector, nil, &ilc3, arg1, arg2, arg3));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5734
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5735
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5736
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5737
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5738
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5739
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5740
perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5741
    "send the four-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5742
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5743
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5744
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5745
    static struct inlineCache ilc_0 = __ILCPERF4(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5746
    static struct inlineCache ilc_1 = __ILCPERF4(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5747
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5748
    static OBJ last_1 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5749
    static flip = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5750
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5751
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5752
        if (aSelector != last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5753
            if (aSelector != last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5754
                if (flip) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5755
                    pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5756
                    flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5757
                    last_0 = aSelector;
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
                    pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5760
                    flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5761
                    last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5762
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5763
                pIlc->ilc_func = __SEND4ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5764
                if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5765
                    __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5766
                    pIlc->ilc_poly = 0;
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
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5769
                pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5770
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5771
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5772
            pIlc = &ilc_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
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5775
                                     arg1, arg2, arg3, arg4) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5776
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5777
        static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5778
        RETURN (_SEND4(self, aSelector, nil, &ilc4,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5779
                       arg1, arg2, arg3, arg4));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5780
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5781
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5782
    ^ 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
  5783
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5784
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5785
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5786
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
  5787
    "send the five-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5788
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5789
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5790
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5791
    static struct inlineCache ilc_0 = __ILCPERF5(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5792
    static struct inlineCache ilc_1 = __ILCPERF5(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5793
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5794
    static OBJ last_1 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5795
    static flip = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5796
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5797
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5798
        if (aSelector != last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5799
            if (aSelector != last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5800
                if (flip) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5801
                    pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5802
                    flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5803
                    last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5804
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5805
                    pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5806
                    flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5807
                    last_1 = 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
                pIlc->ilc_func = __SEND5ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5810
                if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5811
                    __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5812
                    pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5813
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5814
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5815
                pIlc = &ilc_1;
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
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5818
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5819
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5820
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5821
                                     arg1, arg2, arg3, arg4, arg5) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5822
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5823
        static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5824
        RETURN (_SEND5(self, aSelector, nil, &ilc5,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5825
                       arg1, arg2, arg3, arg4, arg5));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5826
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5827
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5828
    ^ 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
  5829
                                                  with:arg5)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5830
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5831
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5832
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5833
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
  5834
    "send the six-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5835
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5836
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5837
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5838
    static struct inlineCache ilc_0 = __ILCPERF6(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5839
    static struct inlineCache ilc_1 = __ILCPERF6(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5840
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5841
    static OBJ last_1 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5842
    static flip = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5843
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5844
    if (InterruptPending == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5845
        if (aSelector != last_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5846
            if (aSelector != last_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5847
                if (flip) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5848
                    pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5849
                    flip = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5850
                    last_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5851
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5852
                    pIlc = &ilc_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5853
                    flip = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5854
                    last_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5855
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5856
                pIlc->ilc_func = __SEND6ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5857
                if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5858
                    __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5859
                    pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5860
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5861
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5862
                pIlc = &ilc_1;
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
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5865
            pIlc = &ilc_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5866
        }
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
        RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5869
                                     arg1, arg2, arg3, arg4, arg5, arg6) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5870
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5871
        static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5872
        RETURN (_SEND6(self, aSelector, nil, &ilc6,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5873
                       arg1, arg2, arg3, arg4, arg5, arg6));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5874
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5875
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5876
    ^ 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
  5877
                                                  with:arg5 with:arg6)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5878
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5879
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5880
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5881
perform:aSelector withArguments:argArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5882
    "send the message aSelector with all args taken from argArray 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5883
     to the receiver."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5884
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5885
    |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
  5886
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5887
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5888
    REGISTER OBJ *argP;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5889
    int nargs;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5890
    OBJ l;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5891
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  5892
    if (__isArrayLike(argArray)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5893
        nargs = __arraySize(argArray);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5894
        argP = __arrayVal(argArray);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5895
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5896
        if (__isNonNilObject(argArray)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5897
            static struct inlineCache ilcSize = __ILC0(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5898
            int i;
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
            numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize); 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5901
            if (!__isSmallInteger(numberOfArgs)) 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5902
                goto bad;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5903
            nargs = __intVal(numberOfArgs);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5904
            argP = (OBJ *)(&a1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5905
            for (i=1; i <= nargs; i++) {
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  5906
                *argP++ = __AT_(argArray, __mkSmallInteger(i));
6654
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
            argP = (OBJ *)(&a1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5909
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5910
            nargs = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5911
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5912
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5913
    switch (nargs) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5914
        case 0:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5915
            if (InterruptPending == nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5916
                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
  5917
                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
  5918
                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
  5919
                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
  5920
                static int flip0 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5921
                struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5922
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5923
                if (aSelector == last0_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5924
                    pIlc = &ilc0_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5925
                } else if (aSelector == last0_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5926
                    pIlc = &ilc0_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5927
                } else if (aSelector == last0_2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5928
                    pIlc = &ilc0_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5929
                } else if (aSelector == last0_3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5930
                    pIlc = &ilc0_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5931
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5932
                    if (flip0 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5933
                        pIlc = &ilc0_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5934
                        flip0 = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5935
                        last0_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5936
                    } else if (flip0 == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5937
                        pIlc = &ilc0_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5938
                        flip0 = 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5939
                        last0_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5940
                    } else if (flip0 == 2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5941
                        pIlc = &ilc0_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5942
                        flip0 = 3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5943
                        last0_2 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5944
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5945
                        pIlc = &ilc0_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5946
                        flip0 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5947
                        last0_3 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5948
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5949
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5950
                    pIlc->ilc_func = __SEND0ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5951
                    if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5952
                        __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5953
                        pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5954
                    }
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
                RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5957
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5958
                static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5959
                RETURN (_SEND0(self, aSelector, nil, &ilc0));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5960
            }
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
        case 1: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5963
            if (InterruptPending == nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5964
                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
  5965
                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
  5966
                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
  5967
                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
  5968
                static int flip1 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5969
                struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5970
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5971
                if (aSelector == last1_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5972
                    pIlc = &ilc1_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5973
                } else if (aSelector == last1_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5974
                    pIlc = &ilc1_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5975
                } else if (aSelector == last1_2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5976
                    pIlc = &ilc1_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5977
                } else if (aSelector == last1_3) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5978
                    pIlc = &ilc1_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5979
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5980
                    if (flip1 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5981
                        pIlc = &ilc1_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5982
                        flip1 = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5983
                        last1_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5984
                    } else if (flip1 == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5985
                        pIlc = &ilc1_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5986
                        flip1 = 2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5987
                        last1_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5988
                    } else if (flip1 == 2) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5989
                        pIlc = &ilc1_2;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5990
                        flip1 = 3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5991
                        last1_2 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5992
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5993
                        pIlc = &ilc1_3;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5994
                        flip1 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5995
                        last1_3 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5996
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5997
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5998
                    pIlc->ilc_func = __SEND1ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  5999
                    if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6000
                        __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6001
                        pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6002
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6003
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6004
                RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6005
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6006
                static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6007
                RETURN (_SEND1(self, aSelector, nil, &ilc1, argP[0]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6008
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6009
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6010
        case 2: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6011
            if (InterruptPending == nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6012
                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
  6013
                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
  6014
                static int flip2 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6015
                struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6016
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6017
                if (aSelector == last2_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6018
                    pIlc = &ilc2_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6019
                } else if (aSelector == last2_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6020
                    pIlc = &ilc2_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6021
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6022
                    if (flip2 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6023
                        pIlc = &ilc2_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6024
                        flip2 = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6025
                        last2_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6026
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6027
                        pIlc = &ilc2_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6028
                        flip2 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6029
                        last2_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6030
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6031
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6032
                    pIlc->ilc_func = __SEND2ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6033
                    if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6034
                        __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6035
                        pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6036
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6037
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6038
                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
  6039
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6040
                static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6041
                RETURN (_SEND2(self, aSelector, nil, &ilc2, argP[0], argP[1]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6042
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6043
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6044
        case 3: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6045
            if (InterruptPending == nil) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6046
                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
  6047
                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
  6048
                static int flip3 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6049
                struct inlineCache *pIlc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6050
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6051
                if (aSelector == last3_0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6052
                    pIlc = &ilc3_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6053
                } else if (aSelector == last3_1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6054
                    pIlc = &ilc3_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6055
                } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6056
                    if (flip3 == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6057
                        pIlc = &ilc3_0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6058
                        flip3 = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6059
                        last3_0 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6060
                    } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6061
                        pIlc = &ilc3_1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6062
                        flip3 = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6063
                        last3_1 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6064
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6065
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6066
                    pIlc->ilc_func = __SEND3ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6067
                    if (pIlc->ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6068
                        __flushPolyCache(pIlc->ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6069
                        pIlc->ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6070
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6071
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6072
                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
  6073
            } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6074
                static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6075
                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
  6076
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6077
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6078
        case 4: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6079
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6080
                static OBJ last4 = nil; static struct inlineCache ilc4 = __ILCPERF4(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6081
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6082
                if ((InterruptPending != nil) || (aSelector != last4)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6083
                    ilc4.ilc_func = __SEND4ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6084
                    if (ilc4.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6085
                        __flushPolyCache(ilc4.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6086
                        ilc4.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6087
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6088
                    last4 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6089
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6090
                RETURN ( (*ilc4.ilc_func)(self, aSelector, nil, &ilc4,
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6091
                                                argP[0], argP[1], argP[2], argP[3]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6092
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6093
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6094
        case 5: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6095
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6096
                static OBJ last5 = nil; static struct inlineCache ilc5 = __ILCPERF5(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6097
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6098
                if ((InterruptPending != nil) || (aSelector != last5)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6099
                    ilc5.ilc_func = __SEND5ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6100
                    if (ilc5.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6101
                        __flushPolyCache(ilc5.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6102
                        ilc5.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6103
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6104
                    last5 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6105
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6106
                RETURN ( (*ilc5.ilc_func)(self, aSelector, nil, &ilc5, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6107
                                                argP[0], argP[1], argP[2], argP[3], argP[4]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6108
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6109
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6110
        case 6: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6111
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6112
                static OBJ last6 = nil; static struct inlineCache ilc6 = __ILCPERF6(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6113
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6114
                if ((InterruptPending != nil) || (aSelector != last6)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6115
                    ilc6.ilc_func = __SEND6ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6116
                    if (ilc6.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6117
                        __flushPolyCache(ilc6.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6118
                        ilc6.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6119
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6120
                    last6 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6121
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6122
                RETURN ( (*ilc6.ilc_func)(self, aSelector, nil, &ilc6, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6123
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6124
                                                argP[5]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6125
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6126
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6127
        case 7: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6128
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6129
                static OBJ last7 = nil; static struct inlineCache ilc7 = __ILCPERF7(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6130
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6131
                if ((InterruptPending != nil) || (aSelector != last7)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6132
                    ilc7.ilc_func = __SEND7ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6133
                    if (ilc7.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6134
                        __flushPolyCache(ilc7.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6135
                        ilc7.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6136
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6137
                    last7 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6138
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6139
                RETURN ( (*ilc7.ilc_func)(self, aSelector, nil, &ilc7, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6140
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6141
                                                argP[5], argP[6]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6142
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6143
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6144
        case 8:
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6145
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6146
                static OBJ last8 = nil; static struct inlineCache ilc8 = __ILCPERF8(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6147
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6148
                if ((InterruptPending != nil) || (aSelector != last8)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6149
                    ilc8.ilc_func = __SEND8ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6150
                    if (ilc8.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6151
                        __flushPolyCache(ilc8.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6152
                        ilc8.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6153
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6154
                    last8 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6155
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6156
                RETURN ( (*ilc8.ilc_func)(self, aSelector, nil, &ilc8, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6157
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6158
                                                argP[5], argP[6], argP[7]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6159
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6160
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6161
        case 9: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6162
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6163
                static OBJ last9 = nil; static struct inlineCache ilc9 = __ILCPERF9(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6164
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6165
                if ((InterruptPending != nil) || (aSelector != last9)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6166
                    ilc9.ilc_func = __SEND9ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6167
                    if (ilc9.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6168
                        __flushPolyCache(ilc9.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6169
                        ilc9.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6170
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6171
                    last9 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6172
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6173
                RETURN ( (*ilc9.ilc_func)(self, aSelector, nil, &ilc9, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6174
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6175
                                                argP[5], argP[6], argP[7], argP[8]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6176
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6177
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6178
        case 10: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6179
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6180
                static OBJ last10 = nil; static struct inlineCache ilc10 = __ILCPERF10(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6181
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6182
                if ((InterruptPending != nil) || (aSelector != last10)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6183
                    ilc10.ilc_func = __SEND10ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6184
                    if (ilc10.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6185
                        __flushPolyCache(ilc10.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6186
                        ilc10.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6187
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6188
                    last10 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6189
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6190
                RETURN ( (*ilc10.ilc_func)(self, aSelector, nil, &ilc10, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6191
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6192
                                                argP[5], argP[6], argP[7], argP[8], argP[9]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6193
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6194
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6195
        case 11: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6196
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6197
                static OBJ last11 = nil; static struct inlineCache ilc11 = __ILCPERF11(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6198
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6199
                if ((InterruptPending != nil) || (aSelector != last11)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6200
                    ilc11.ilc_func = __SEND11ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6201
                    if (ilc11.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6202
                        __flushPolyCache(ilc11.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6203
                        ilc11.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6204
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6205
                    last11 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6206
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6207
                RETURN ( (*ilc11.ilc_func)(self, aSelector, nil, &ilc11, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6208
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6209
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6210
                                                argP[10]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6211
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6212
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6213
        case 12: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6214
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6215
                static OBJ last12 = nil; static struct inlineCache ilc12 = __ILCPERF12(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6216
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6217
                if ((InterruptPending != nil) || (aSelector != last12)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6218
                    ilc12.ilc_func = __SEND12ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6219
                    if (ilc12.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6220
                        __flushPolyCache(ilc12.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6221
                        ilc12.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6222
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6223
                    last12 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6224
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6225
                RETURN ( (*ilc12.ilc_func)(self, aSelector, nil, &ilc12, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6226
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6227
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6228
                                                argP[10], argP[11]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6229
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6230
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6231
        case 13: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6232
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6233
                static OBJ last13 = nil; static struct inlineCache ilc13 = __ILCPERF13(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6234
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6235
                if ((InterruptPending != nil) || (aSelector != last13)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6236
                    ilc13.ilc_func = __SEND13ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6237
                    if (ilc13.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6238
                        __flushPolyCache(ilc13.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6239
                        ilc13.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6240
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6241
                    last13 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6242
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6243
                RETURN ( (*ilc13.ilc_func)(self, aSelector, nil, &ilc13, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6244
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6245
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6246
                                                argP[10], argP[11], argP[12]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6247
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6248
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6249
        case 14: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6250
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6251
                static OBJ last14 = nil; static struct inlineCache ilc14 = __ILCPERF14(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6252
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6253
                if ((InterruptPending != nil) || (aSelector != last14)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6254
                    ilc14.ilc_func = __SEND14ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6255
                    if (ilc14.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6256
                        __flushPolyCache(ilc14.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6257
                        ilc14.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6258
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6259
                    last14 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6260
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6261
                RETURN ( (*ilc14.ilc_func)(self, aSelector, nil, &ilc14, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6262
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6263
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6264
                                                argP[10], argP[11], argP[12], argP[13]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6265
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6266
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6267
        case 15: 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6268
            {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6269
                static OBJ last15 = nil; static struct inlineCache ilc15 = __ILCPERF15(@line);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6270
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6271
                if ((InterruptPending != nil) || (aSelector != last15)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6272
                    ilc15.ilc_func = __SEND15ADDR__;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6273
                    if (ilc15.ilc_poly) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6274
                        __flushPolyCache(ilc15.ilc_poly);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6275
                        ilc15.ilc_poly = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6276
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6277
                    last15 = aSelector;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6278
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6279
                RETURN ( (*ilc15.ilc_func)(self, aSelector, nil, &ilc15, 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6280
                                                argP[0], argP[1], argP[2], argP[3], argP[4],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6281
                                                argP[5], argP[6], argP[7], argP[8], argP[9],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6282
                                                argP[10], argP[11], argP[12], argP[13],
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6283
                                                argP[14]));
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6284
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6285
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6286
bad:;
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6289
    "/ arrive here, if bad number of arguments (too many)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6290
    "/ ST/X (currently) only allows up to 15 method arguments
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
    ^ self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6293
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6294
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6295
perform:aSelector withOptionalArgument:arg
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6296
    "send aSelector-message to the receiver.
6318
3677d346113a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6316
diff changeset
  6297
     If the message expects an argument, pass arg."
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6298
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6299
    aSelector numArgs == 1 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6300
        ^ self perform:aSelector with:arg
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6301
    ].
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6302
    ^ self perform:aSelector
6319
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6303
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6304
    "
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6305
     |rec sel|
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6306
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6307
     rec := -1.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6308
     sel := #abs.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6309
     rec perform:sel withOptionalArgument:2.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6310
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6311
     sel := #max:.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6312
     rec perform:sel withOptionalArgument:2.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6313
    "
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6314
!
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6315
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6316
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6317
    "send aSelector-message to the receiver.
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6318
     Depending on the number of arguments the message expects,
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6319
     pass either none, 1, or 2 arguments."
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6320
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6321
    |numArgs|
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6322
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6323
    numArgs := aSelector numArgs.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6324
    numArgs == 0 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6325
        ^ self perform:aSelector
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6326
    ].
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6327
    numArgs == 1 ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6328
        ^ self perform:aSelector with:optionalArg1
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6329
    ].
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6330
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6331
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6332
    "
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6333
     |rec sel|
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6334
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6335
     rec := -1.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6336
     sel := #abs.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6337
     rec perform:sel withOptionalArgument:2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6338
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6339
     sel := #max:.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6340
     rec perform:sel withOptionalArgument:2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6341
    "
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6342
!
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6343
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6344
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2 and:optionalArg3
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6345
    "send aSelector-message to the receiver.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6346
     Depending on the number of arguments the message expects,
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6347
     pass either none, 1, 2 or 3 arguments."
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6348
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6349
    |numArgs|
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6350
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6351
    numArgs := aSelector numArgs.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6352
    numArgs == 0 ifTrue:[
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6353
        ^ self perform:aSelector
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6354
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6355
    numArgs == 1 ifTrue:[
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6356
        ^ self perform:aSelector with:optionalArg1
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6357
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6358
    numArgs == 2 ifTrue:[
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6359
        ^ self perform:aSelector with:optionalArg1 with:optionalArg2
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6360
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6361
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6362
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6363
    "
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6364
     |rec sel|
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6365
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6366
     rec := -1.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6367
     sel := #abs.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6368
     rec perform:sel withOptionalArgument:2.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6369
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6370
     sel := #max:.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6371
     rec perform:sel withOptionalArgument:2.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6372
    "
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6373
!
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6374
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6375
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2 and:optionalArg3 and:optionalArg4
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6376
    "send aSelector-message to the receiver.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6377
     Depending on the number of arguments the message expects,
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6378
     pass either none, 1, 2, 3 or 4 arguments."
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6379
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6380
    |numArgs|
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6381
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6382
    numArgs := aSelector numArgs.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6383
    numArgs == 0 ifTrue:[
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6384
        ^ self perform:aSelector
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6385
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6386
    numArgs == 1 ifTrue:[
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6387
        ^ self perform:aSelector with:optionalArg1
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6388
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6389
    numArgs == 2 ifTrue:[
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6390
        ^ self perform:aSelector with:optionalArg1 with:optionalArg2
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6391
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6392
    numArgs == 3 ifTrue:[
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6393
        ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6394
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6395
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3 with:optionalArg4.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6396
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6397
    "
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6398
     |rec sel|
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6399
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6400
     rec := -1.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6401
     sel := #abs.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6402
     rec perform:sel withOptionalArgument:2.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6403
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6404
     sel := #max:.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6405
     rec perform:sel withOptionalArgument:2.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6406
    "
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6407
!
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6408
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6409
performMethod:aMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6410
    "invoke aMethod on the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6411
     The method should be a zero-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6412
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6413
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6414
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6415
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6416
         receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6417
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6418
    ^ aMethod valueWithReceiver:self arguments:#()
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6419
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
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6422
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6423
     mthd := SmallInteger compiledMethodAt:#negated.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6424
     Transcript showCR:(1 performMethod:mthd)
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6427
    "BAD USE example:
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
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6430
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6431
     mthd := Point compiledMethodAt:#x.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6432
     Transcript showCR:((1->2) performMethod:mthd)
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6435
    "Modified: 31.7.1997 / 17:41:50 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6436
!
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
performMethod:aMethod arguments:argumentArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6439
    "invoke aMethod on the receiver, passing an argumentArray.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6440
     The size of the argumentArray should match the number of args
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6441
     expected by the method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6442
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6443
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6444
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6445
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6446
         receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6447
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6448
    ^ aMethod valueWithReceiver:self arguments:argumentArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6449
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
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6452
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6453
     mthd := SmallInteger compiledMethodAt:#+.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6454
     Transcript showCR:(1 performMethod:mthd arguments:#(2))
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6457
    "Created: 31.7.1997 / 17:46:31 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6460
performMethod:aMethod with:arg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6461
    "invoke aMethod on the receiver, passing an argument.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6462
     The method should be a one-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6463
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6464
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6465
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6466
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6467
         receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6468
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6469
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg)
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6472
     |mthd|
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
     mthd := SmallInteger compiledMethodAt:#+.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6475
     Transcript showCR:(1 performMethod:mthd with:2)
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
    "Modified: 31.7.1997 / 17:42:32 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6479
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6480
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6481
performMethod:aMethod with:arg1 with:arg2
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6482
    "invoke aMethod on the receiver, passing two arguments.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6483
     The method should be a two-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6484
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6485
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6486
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6487
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6488
         receiver - no checking is done by the VM."
5755
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
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6491
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6492
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6493
     |mthd arr|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6494
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6495
     arr := Array new:1.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6496
     mthd := Array compiledMethodAt:#basicAt:put:.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6497
     arr performMethod:mthd with:1 with:'foo'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6498
     Transcript showCR:arr
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
    "Modified: 31.7.1997 / 17:44:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6502
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6503
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6504
performMethod:aMethod with:arg1 with:arg2 with:arg3
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6505
    "invoke aMethod on the receiver, passing three arguments.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6506
     The method should be a three-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6507
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6508
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6509
     Warning:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6510
         Take care for the method to be appropriate for the
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6511
         receiver - no checking is done by the VM."
5755
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
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2 with:arg3)
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
    "Created: 31.7.1997 / 17:45:20 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6516
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6517
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6518
!Object methodsFor:'printing & storing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6519
6235
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6520
basicPrintOn:aStream
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6521
    "append the receivers className with an articel to the argument, aStream"
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6522
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6523
    aStream nextPutAll:self classNameWithArticle
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6524
!
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6525
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6526
className
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6527
    "return the classname of the receivers class"
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
    ^ self class name
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6530
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6531
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6532
     1 className
9105
1666cb465e3f comments
Stefan Vogel <sv@exept.de>
parents: 9071
diff changeset
  6533
     1 class className 
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6534
     $a className
9105
1666cb465e3f comments
Stefan Vogel <sv@exept.de>
parents: 9071
diff changeset
  6535
     $a class className
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6536
    "
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
classNameWithArticle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6540
    "return a string consisting of classname preceeded by an article.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6541
     (dont expect me to write national variants for this ... :-)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6542
     If you have special preferences, redefine it ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6543
6829
db28715efb4d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6815
diff changeset
  6544
    | cls|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6545
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6546
    (cls := self class) == self ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6547
        ^ 'a funny object'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6548
    ].
6829
db28715efb4d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6815
diff changeset
  6549
    ^ cls nameWithArticle
5755
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
    "
6418
0883a068e491 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6405
diff changeset
  6552
     1 classNameWithArticle   
0883a068e491 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6405
diff changeset
  6553
     (1->2) classNameWithArticle    
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6554
     XWorkstation basicNew classNameWithArticle
6418
0883a068e491 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6405
diff changeset
  6555
     XWorkstation classNameWithArticle 
5755
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
    "Modified: 13.5.1996 / 12:16:14 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6559
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6560
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6561
errorPrint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6562
    "print the receiver on the standard error stream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6563
7285
76ff65cdd7e7 Stream streamErrorSignal -> StreamError
Stefan Vogel <sv@exept.de>
parents: 7266
diff changeset
  6564
    StreamError catch:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6565
        self printOn:Stderr
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6566
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6567
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6568
    "Modified: 7.3.1996 / 19:11:29 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6569
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6570
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6571
errorPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6572
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6573
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6574
    "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
  6575
7285
76ff65cdd7e7 Stream streamErrorSignal -> StreamError
Stefan Vogel <sv@exept.de>
parents: 7266
diff changeset
  6576
    StreamError catch:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6577
        self printOn:Stderr.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6578
        Stderr cr
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6579
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6580
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6581
    "Modified: 7.3.1996 / 19:13:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6582
    "Created: 20.5.1996 / 10:20:41 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6583
!
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
errorPrintNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6586
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6587
    <resource:#obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6588
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6589
    "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
  6590
     Please use #errorPrintCR - this method exists for backward compatibility."
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
    ^ self errorPrintCR
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
    "Modified: 20.5.1996 / 10:24:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6595
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6596
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6597
errorPrintNewline
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6598
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6599
    <resource:#obsolete>
5755
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
    "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
  6602
     Please use #errorPrintCR - this method exists for backward compatibility."
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
    self errorPrintCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6605
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6606
    "Modified: 20.5.1996 / 10:24:38 / cg"
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
infoPrint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6610
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6611
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6612
    "print the receiver on the standard error stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6613
     This is meant for information messages which are not warnings
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6614
     or fatal messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6615
     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
  6616
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6617
    InfoPrinting == true ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6618
        self errorPrint
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6619
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6620
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6621
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6622
infoPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6623
    "{ Pragma: +optSpace }"
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
    "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
  6626
     This is meant for information messages which are not warnings
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6627
     or fatal messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6628
     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
  6629
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6630
    InfoPrinting == true ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6631
        self errorPrintCR
5755
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
    "Created: 20.5.1996 / 10:21:28 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6635
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6636
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6637
infoPrintNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6638
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6639
    <resource:#obsolete>
5755
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
    "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
  6642
     Please use #infoPrintCR - this method exists for backward compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6643
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6644
    ^ self infoPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6645
!
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
print
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6648
    "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
  6649
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6650
    "/ the following allows printCR to be used during
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6651
    "/ the early init-phase, when no Stdout has been set up.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6652
    "/ (depends on string to respond to #print)
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
    Stdout isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6655
        self printString print.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6656
        ^ self
5755
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
    self printOn:Stdout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6659
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6660
    "Modified: 4.11.1996 / 23:36:58 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6661
!
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
printCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6664
    "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
  6665
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6666
    "/ the following allows printCR to be used during
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6667
    "/ the early init-phase, when no Stdout has been set up.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6668
    "/ (depends on string to respond to #printCR)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6669
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6670
    Stdout isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6671
        self printString printCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6672
        ^ self
5755
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
    self printOn:Stdout.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6675
    Stdout cr
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
    "Created: 20.5.1996 / 10:21:37 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6678
    "Modified: 4.11.1996 / 23:37:06 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6679
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6680
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6681
printNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6682
    "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
  6683
     This exists for GNU Smalltalk compatibility - please use #printCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6684
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6685
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6686
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6687
    ^ self printCR
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
    "Modified: 20.5.1996 / 10:25:31 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6692
printNewline
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6693
    "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
  6694
     This exists for backward compatibility - please use #printCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6695
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6696
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  6697
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6698
    self printCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6699
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6700
    "Modified: 20.5.1996 / 10:25:46 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6703
printOn:aStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6704
    "append a user printed representation of the receiver to aStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6705
     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
  6706
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6707
     The default here is to output the receivers class name.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6708
     BUT: this method is heavily redefined for objects which
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6709
     can print prettier."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6710
6235
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6711
    self basicPrintOn:aStream.
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6712
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6713
   "
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6714
    (1@2) printOn:Transcript
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6715
    (1@2) basicPrintOn:Transcript
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  6716
   "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6717
!
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
printOn:aStream leftPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6720
    "print the receiver on aStream, padding with spaces up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6721
     padding is done on the left."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6722
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6723
    self printOn:aStream leftPaddedTo:size with:(Character space)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6724
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6725
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6726
     123 printOn:Transcript leftPaddedTo:10. Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6727
     123 printOn:Transcript leftPaddedTo:2. Transcript cr
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6730
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6731
printOn:aStream leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6732
    "print the receiver on aStream, padding with padCharacters up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6733
     padding is done on the left."
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
    aStream nextPutAll:(self printStringLeftPaddedTo:size with:padCharacter)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6736
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6737
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6738
     123 printOn:Transcript leftPaddedTo:10 with:$_ . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6739
     123 printOn:Transcript leftPaddedTo:10 with:$. . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6740
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6741
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6742
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6743
printOn:aStream paddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6744
    "print the receiver on aStream, padding with spaces up to size."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6745
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6746
    self printOn:aStream paddedTo:size with:(Character space)
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6749
     123.0 printOn:Transcript paddedTo:10. Transcript nextPut:$|. Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6750
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6751
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6752
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6753
printOn:aStream paddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6754
    "print the receiver on aStream, padding with padCharacter up to size"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6756
    aStream nextPutAll:(self printStringPaddedTo:size with:padCharacter).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6757
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6758
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6759
     123 printOn:Transcript paddedTo:10 with:$_ . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6760
     123 printOn:Transcript paddedTo:10 with:$. . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6761
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6762
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6763
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6764
printOn:aStream zeroPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6765
    "print the receiver on aStream, padding with zeros up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6766
     Usually used with float numbers."
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
    self printOn:aStream paddedTo:size with:$0.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6769
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
     123.0 printOn:Transcript zeroPaddedTo:10
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6775
printRightAdjustLen:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6776
    "obsolete - just a name confusion.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6777
     This method will go away ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6778
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6779
    (self printStringLeftPaddedTo:size) printOn:Stdout
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
printString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6783
    "return a string for printing the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6784
     Since we now use printOn: as the basic print mechanism,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6785
     we have to create a stream and print into it."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6786
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6787
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6788
8300
d15ead94361f Use CharacterWriteStream in #printString (speedup)
Stefan Vogel <sv@exept.de>
parents: 8287
diff changeset
  6789
    s := CharacterWriteStream on:(String basicNew:30).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6790
    self printOn:s.
8300
d15ead94361f Use CharacterWriteStream in #printString (speedup)
Stefan Vogel <sv@exept.de>
parents: 8287
diff changeset
  6791
    ^ s contents.
7978
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  6792
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  6793
    "
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  6794
     Date today printString.
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  6795
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6796
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6797
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6798
printStringLeftPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6799
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6800
     characters on the left are filled with spaces.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6801
     If the printString is longer than size, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6802
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6803
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6804
    ^ self printStringLeftPaddedTo:size with:(Character space)
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
     10 printStringLeftPaddedTo:10
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6808
     1 printStringLeftPaddedTo:10
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6811
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6812
printStringLeftPaddedTo:size ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6813
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6814
     characters on the left are filled with spaces.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6815
     If the printString is larger than size,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6816
     return the result from evaluating alternative."
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
    ^ self printStringLeftPaddedTo:size with:(Character space) ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6819
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6820
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6821
     12   printStringLeftPaddedTo:3 ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6822
     123  printStringLeftPaddedTo:3 ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6823
     1234 printStringLeftPaddedTo:3 ifLarger:['***']
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6826
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6827
printStringLeftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6828
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6829
     characters on the left are filled with padCharacter.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6830
     If the printString is longer than size, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6831
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6832
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6833
    ^ (self printString) leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6834
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6835
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6836
     123 printStringLeftPaddedTo:10 with:$.   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6837
     1 printStringLeftPaddedTo:10 with:$.      
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6838
     (Float pi) printStringLeftPaddedTo:20 with:$*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6839
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6840
!
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
printStringLeftPaddedTo:size with:padCharacter ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6843
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6844
     characters on the left are filled with padCharacter.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6845
     If the printString is larger than size,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6846
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6847
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6848
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6849
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6850
    s := self printString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6851
    s size > size ifTrue:[^ alternative value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6852
    ^ s leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6853
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6854
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6855
     12   printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6856
     123  printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6857
     1234 printStringLeftPaddedTo:3 with:$. ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6858
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6859
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6860
8576
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6861
printStringLimitedTo:sizeLimit
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6862
    "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
  6863
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6864
    |s|
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6865
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6866
    s := CharacterWriteStream on:(String basicNew:30).
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6867
    s writeLimit:sizeLimit.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6868
    self printOn:s.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6869
    ^ s contents.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6870
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6871
    "
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6872
     Date today printStringLimitedTo:5.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6873
     '12345678901234567890' printStringLimitedTo:5. 
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6874
    "
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6875
!
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  6876
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6877
printStringOnError:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6878
    "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
  6879
     evaluating exceptionBlock. Useful to print something in an exceptionHandler or other
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6880
     cleanup code."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6881
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6882
    |rslt|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6883
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6884
    Error handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6885
        rslt := exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6886
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  6887
        rslt := self printString
5755
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
    ^ rslt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6890
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6891
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6892
printStringPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6893
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6894
     padded with spaces (at the right) up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6895
     If the printString is longer than size, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6896
     it is returned unchanged (i.e. not truncated)"
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
    ^ self printStringPaddedTo:size with:(Character space)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6899
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6900
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6901
     123 printStringPaddedTo:10    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6902
     1234567890123456 printStringPaddedTo:10  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6903
     'hello' printStringPaddedTo:10   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6904
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6905
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6906
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6907
printStringPaddedTo:size ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6908
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6909
     padded with spaces (at the right) up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6910
     If the resulting printString is too large, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6911
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6912
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6913
    ^ self printStringPaddedTo:size with:(Character space) ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6914
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6915
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6916
     12   printStringPaddedTo:3 ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6917
     123  printStringPaddedTo:3 ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6918
     1234 printStringPaddedTo:3 ifLarger:['***']   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6919
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6920
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6921
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6922
printStringPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6923
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6924
     padded with padCharacter (at the right) up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6925
     If the printString is longer than size, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6926
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6927
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6928
    ^ (self printString) paddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6929
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
     123  printStringPaddedTo:10 with:$.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6932
     123  printStringPaddedTo:10 with:$*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6933
     123  printStringPaddedTo:3 with:$*   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6934
     1234 printStringPaddedTo:3 with:$*   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6935
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6936
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6937
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6938
printStringPaddedTo:size with:padCharacter ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6939
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6940
     padded with padCharacter (at the right) up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6941
     If the resulting printString is too large, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6942
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6943
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6944
    |s|
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
    s := self printString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6947
    s size > size ifTrue:[^ alternative value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6948
    ^ s paddedTo:size with:padCharacter
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
     123   printStringPaddedTo:3 with:$. ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6952
     12345 printStringPaddedTo:3 with:$. ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6953
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6954
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6955
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6956
printStringRightAdjustLen:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6957
    "obsolete - just a name confusion.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6958
     This method will go away ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6959
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6960
    ^ self printStringLeftPaddedTo:size
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6963
printStringZeroPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6964
    "return a printed representation of the receiver, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6965
     padded with zero (at the right) characters up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6966
     Usually used with float numbers."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6967
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6968
    ^ self printStringPaddedTo:size with:$0
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6969
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6970
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6971
     123.0 printStringZeroPaddedTo:10 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6972
    "
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
8287
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6975
printfPrintString:ignoredFormat
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6976
    "fallback to default printString
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6977
     (for compatibility with float and integer-printing)"
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6978
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6979
    ^ self printString
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6980
!
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  6981
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6982
store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6983
    "store the receiver on standard output.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6984
     this method is useless, but included for compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6985
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6986
    self storeOn:Stdout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6987
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6988
7600
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6989
storeArrayElementOn:aStream
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6990
    "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
  6991
     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
  6992
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6993
    ^ 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
  6994
!
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  6995
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6996
storeCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6997
    "store the receiver on standard output; append a carriage return."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6998
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6999
    self store.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7000
    Character cr print
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
    "Created: 20.5.1996 / 10:26:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7003
    "Modified: 20.5.1996 / 10:26:57 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7006
storeNl
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7007
    "store the receiver on standard output; append a newline.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7008
     This method is included for backward compatibility-  use #storeCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7009
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7010
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7011
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7012
    self storeCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7013
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7014
    "Modified: 20.5.1996 / 10:26:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7015
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7016
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7017
storeOn:aStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7018
    "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
  7019
     reconstruct the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7020
     Notice, that no self referencing or cyclic objects can be represented
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7021
     in this format.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7022
     Use storeBinaryOn:, which handles these cases correctly."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7023
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7024
    |myClass hasSemi sz "{ Class: SmallInteger }" |
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
    thisContext isRecursive ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7027
        Object recursiveStoreStringSignal raiseRequestWith:self.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7028
        ('Object [error]: storeString of self referencing object.') errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7029
        aStream nextPutAll:'#("recursive")'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7030
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7031
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7032
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7033
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7034
    aStream nextPut:$(.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7035
    aStream nextPutAll:self class name.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7036
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7037
    hasSemi := false.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7038
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7039
        aStream nextPutAll:' basicNew:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7040
        self basicSize printOn:aStream
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7041
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7042
        aStream nextPutAll:' basicNew'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7043
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7044
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7045
    sz := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7046
    1 to:sz do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7047
        aStream nextPutAll:' instVarAt:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7048
        i printOn:aStream.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7049
        aStream nextPutAll:' put:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7050
        (self instVarAt:i) storeOn:aStream.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7051
        aStream nextPut:$;.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7052
        hasSemi := true
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
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7055
        sz := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7056
        1 to:sz do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7057
            aStream nextPutAll:' basicAt:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7058
            i printOn:aStream.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7059
            aStream nextPutAll:' put:'.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7060
            (self basicAt:i) storeOn:aStream.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7061
            aStream nextPut:$;.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7062
            hasSemi := true
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7063
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7064
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7065
    hasSemi ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7066
        aStream nextPutAll:' yourself'
5755
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
    aStream nextPut:$).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7069
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7070
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7071
     |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7072
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7073
     s := WriteStream on:(String new).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7074
     ('hello' -> 'world') storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7075
     s := ReadStream on:(s contents).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7076
     (Object readFrom:s) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7077
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7078
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7079
     |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7080
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7081
     s := 'data' asFilename writeStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7082
     ('hello' -> 'world') storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7083
     s close.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7084
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7085
     s := 'data' asFilename readStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7086
     (Object readFrom:s) inspect
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
    "does not work example:"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7090
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7091
     |s a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7092
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7093
     a := Array new:2.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7094
     a at:1 put:a.
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
     s := 'data' asFilename writeStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7097
     a storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7098
     s close.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7099
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7100
     s := 'data' asFilename readStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7101
     (Object readFrom:s) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7102
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7103
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7104
    "Modified: 28.1.1997 / 00:36:12 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7105
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7106
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7107
storeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7108
    "return a string representing an expression to reconstruct the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7109
     Notice, that no self referencing or cyclic objects can be represented
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7110
     in this format.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7111
     Use storeBinaryOn:, which handles these cases correctly."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7112
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7113
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7114
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7115
    s := WriteStream on:(String new:50).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7116
    self storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7117
    ^ s contents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7118
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7119
9335
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
  7120
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7121
!Object methodsFor:'queries'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7122
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7123
basicSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7124
    "return the number of the receivers indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7125
     0 if it has none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7126
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7127
     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
  7128
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7129
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7130
8909
485a8e3153e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  7131
    REGISTER INT nbytes;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7132
    REGISTER OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7133
    int nInstBytes;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7134
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7135
    /*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7136
     * notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7137
     * this can be done since basicSize is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7138
     * and SmallInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7139
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7140
    myClass = __qClass(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7141
    nbytes = __qSize(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7142
    nInstBytes = OHDR_SIZE + __OBJS2BYTES__( __intVal(__ClassInstPtr(myClass)->c_ninstvars) );
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
    switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7145
        case __MASKSMALLINT(POINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7146
        case __MASKSMALLINT(WKPOINTERARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7147
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  7148
            RETURN ( __mkSmallInteger(__BYTES2OBJS__(nbytes)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7149
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7150
        case __MASKSMALLINT(BYTEARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7151
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  7152
            RETURN ( __mkSmallInteger(nbytes / sizeof(char)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7153
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7154
        case __MASKSMALLINT(FLOATARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7155
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  7156
            RETURN ( __mkSmallInteger(nbytes / sizeof(float)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7157
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7158
        case __MASKSMALLINT(DOUBLEARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7159
#ifdef __NEED_DOUBLE_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7160
            nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7161
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7162
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  7163
            RETURN ( __mkSmallInteger(nbytes / sizeof(double)) );
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7164
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7165
        case __MASKSMALLINT(WORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7166
        case __MASKSMALLINT(SWORDARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7167
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  7168
            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
  7169
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7170
        case __MASKSMALLINT(LONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7171
        case __MASKSMALLINT(SLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7172
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  7173
            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
  7174
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7175
        case __MASKSMALLINT(LONGLONGARRAY):
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7176
        case __MASKSMALLINT(SLONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7177
#ifdef __NEED_LONGLONG_ALIGN
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7178
            nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7179
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7180
            nbytes -= nInstBytes;
8913
b9498d27a554 64bit; mkSmallInteger
Claus Gittinger <cg@exept.de>
parents: 8909
diff changeset
  7181
            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
  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
    ^ 0
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7187
byteSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7188
    "return the number of bytes in the receivers indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7189
     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
  7190
     instvars i.e. byteArrays, wordArrays etc.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7191
     Notice: for Strings the returned size may look strange.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7192
     Only useful with binary storage."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7193
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7194
    |myClass|
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
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7197
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7198
        myClass isPointers ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7199
            myClass isBytes ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7200
                ^ self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7201
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7202
            myClass isWords ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7203
                ^ self basicSize * 2.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7204
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7205
            myClass isSignedWords ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7206
                ^ self basicSize * 2.
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
            myClass isLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7209
                ^ self basicSize * 4.
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
            myClass isSignedLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7212
                ^ self basicSize * 4.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7213
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7214
            myClass isLongLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7215
                ^ self basicSize * 8.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7216
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7217
            myClass isSignedLongLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7218
                ^ self basicSize * 8.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7219
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7220
            myClass isFloats ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7221
                ^ self basicSize * (ExternalBytes sizeofFloat)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7222
            ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7223
            myClass isDoubles ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7224
                ^ self basicSize * (ExternalBytes sizeofDouble)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7225
            ].
8789
4872313c787a Error handling in #byteSize
Stefan Vogel <sv@exept.de>
parents: 8729
diff changeset
  7226
            self error:'unknown variable size class species'.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7227
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7228
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7229
    ^ 0
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7230
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7231
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7232
     Point new byteSize   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7233
     'hello' byteSize     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7234
     (ByteArray with:1 with:2) byteSize 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7235
     (FloatArray with:1.5) byteSize    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7236
     (DoubleArray with:1.5) byteSize    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7237
     (WordArray with:1 with:2) byteSize    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7238
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7239
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7240
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7241
class
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7242
    "return the receivers class"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7243
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7244
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7245
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7246
    RETURN ( __Class(self) );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7247
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7248
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7249
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7250
respondsTo:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7251
    "return true, if the receiver implements a method with selector equal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7252
     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
  7253
     receivers class or one of its superclasses.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7254
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7255
     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
  7256
     an error being raised. For example, an implementation could send
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7257
     #shouldNotImplement or #subclassResponsibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7258
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7259
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7260
     should we go via the cache, or search (by class) ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7261
     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
  7262
     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
  7263
     For now, use the cache ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7264
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7265
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7266
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7267
    if (__lookup(__Class(self), aSelector) == nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7268
        RETURN ( false );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7269
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7270
    RETURN ( true );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7271
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7272
.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7273
    ^ self class canUnderstand:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7274
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7275
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7276
    "'aString' respondsTo:#+"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7277
    "'aString' respondsTo:#,"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7278
    "'aString' respondsTo:#collect:"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7279
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7280
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7281
respondsToArithmetic
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7282
    "return true, if the receiver responds to arithmetic messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7283
     false is returned here - the method is redefined in ArithmeticValue."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7284
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7285
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7286
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7287
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7288
size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7289
    "return the number of the receivers indexed instance variables;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7290
     this method may be redefined in subclasses"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7291
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7292
    ^ self basicSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7293
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7294
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7295
species
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7296
    "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
  7297
     This is used to create an appropriate object when creating derived
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7298
     copies in the collection classes (sometimes redefined)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7299
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7300
    ^ self class
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7301
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7302
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7303
yourself
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7304
    "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
  7305
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7306
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7307
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7308
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7309
!Object methodsFor:'secure message sending'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7310
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7311
askFor:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7312
    "try to send the receiver the message, aSelector.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7313
     If it does not understand it, return false. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7314
     Otherwise the real value returned.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7315
     Useful to send messages such as: #isColor to unknown
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7316
     receivers."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7317
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7318
    ^ self perform:aSelector ifNotUnderstood:[false]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7319
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7320
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7321
     1 askFor:#isColor     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7322
     Color red askFor:#isColor 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7323
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7324
     1 askFor:#isFoo     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7325
     Color red askFor:#isFoo 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7326
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7327
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7328
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7329
perform:aSelector ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7330
    "try to send message aSelector to the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7331
     If its understood, return the methods returned value,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7332
     otherwise return the value of the exceptionBlock"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7333
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7334
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7335
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  7336
    MessageNotUnderstood handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7337
        "/ reject, if the bad message is not the one
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7338
        "/ we have sent originally
8502
7720740cf40f Use MessageNotUnderstood>>#selector
Stefan Vogel <sv@exept.de>
parents: 8500
diff changeset
  7339
        ex selector == aSelector ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7340
            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
  7341
        ].
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7342
        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
  7343
            ex reject
8413
4220f5bb3a39 *** empty log message ***
ca
parents: 8409
diff changeset
  7344
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7345
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7346
        val := self perform:aSelector.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7347
        ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7348
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7349
    ok isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7350
        ^ exceptionBlock value
5755
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
    ^ val
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7353
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7354
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7355
     1.2345 perform:#foo ifNotUnderstood:['sorry'] 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7356
     1.2345 perform:#sqrt ifNotUnderstood:['sorry'] 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7357
     12345 perform:#sqrt ifNotUnderstood:['sorry']  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7358
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7359
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7360
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7361
perform:aSelector with:argument ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7362
    "try to send message aSelector to the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7363
     If its understood, return the methods returned value,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7364
     otherwise return the value of the exceptionBlock"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7365
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7366
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7367
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7368
    MessageNotUnderstood handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7369
        "/ reject, if the bad message is not the one
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7370
        "/ we have sent originally
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7371
        ex selector == aSelector ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7372
            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
  7373
        ].
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7374
        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
  7375
            ex reject
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7376
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7377
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7378
        val := self perform:aSelector with:argument.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7379
        ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7380
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7381
    ok isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7382
        ^ exceptionBlock value
5755
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
    ^ val
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7385
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7386
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7387
     |unknown|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7388
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7389
     unknown := 4.
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7390
     (unknown perform:#- with:2 ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7391
     unknown := 'high there'.
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7392
     (unknown perform:#- with:2 ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7393
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7394
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7395
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7396
perform:aSelector with:arg1 with:arg2 ifNotUnderstood:exceptionBlock
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7397
    "try to send message aSelector to the receiver.
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7398
     If its understood, return the methods returned value,
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7399
     otherwise return the value of the exceptionBlock"
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7400
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7401
    |val ok|
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7402
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7403
    MessageNotUnderstood handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7404
        "/ reject, if the bad message is not the one
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7405
        "/ we have sent originally
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7406
        ex selector == aSelector ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7407
            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
  7408
        ].
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7409
        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
  7410
            ex reject
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7411
        ]
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7412
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7413
        val := self perform:aSelector with:arg1 with:arg2.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7414
        ok := true.
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7415
    ].
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7416
    ok isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7417
        ^ exceptionBlock value
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7418
    ].
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7419
    ^ val
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7420
!
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  7421
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7422
perform:aSelector withArguments:argumentArray ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7423
    "try to send message aSelector to the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7424
     If its understood, return the methods returned value,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7425
     otherwise return the value of the exceptionBlock"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7426
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7427
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7428
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7429
    MessageNotUnderstood handle:[:ex |
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7430
        "/ reject, if the bad message is not the one
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7431
        "/ we have sent originally
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7432
        ex selector == aSelector ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7433
            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
  7434
        ].
c16f744e4536 reject in *ifNotUnderstood, if the message is not the one for myself
Claus Gittinger <cg@exept.de>
parents: 6728
diff changeset
  7435
        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
  7436
            ex reject
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7437
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7438
    ] do:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7439
        val := self perform:aSelector withArguments:argumentArray.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7440
        ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7441
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7442
    ok isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7443
        ^ exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7444
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7445
    ^ val
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7446
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7447
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7448
     |unknown|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7449
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7450
     unknown := 4.
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7451
     (unknown perform:#- withArguments:#(2) ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7452
     unknown := 'high there'.
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7453
     (unknown perform:#- withArguments:#(2) ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7454
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7455
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7456
    "Modified: 27.3.1997 / 14:13:16 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7457
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7458
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7459
!Object methodsFor:'signal constants'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7460
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7461
messageNotUnderstoodSignal
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  7462
    ^ MessageNotUnderstood
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7463
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7464
    "Created: 6.3.1997 / 15:46:52 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7465
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7466
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7467
!Object methodsFor:'special queries'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7468
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7469
allOwners
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7470
    "return a collection of all objects referencing the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7471
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7472
    ^ ObjectMemory whoReferences:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7473
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7474
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7475
references:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7476
    "return true, if the receiver refers to the argument, anObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7477
     - for debugging only"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7478
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7479
    ^ self referencesObject:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7480
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7481
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7482
     |v|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7483
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7484
     v := View new initialize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7485
     v references:Display. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7486
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7487
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7488
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7489
referencesAny:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7490
    "return true, if the receiver refers to any object from 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7491
     the argument, aCollection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7492
     - for debugging only"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7493
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7494
%{  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7495
    OBJ cls, flags;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7496
    int nInsts, inst;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7497
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7498
    if (! __isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7499
        RETURN (false);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7500
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7501
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  7502
    if (__isArrayLike(aCollection)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7503
        int nObjs = __arraySize(aCollection);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7504
        char *minAddr = 0, *maxAddr = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7505
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7506
        if (nObjs == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7507
            RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7508
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7509
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7510
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7511
         * a little optimization: use the fact that all old objects
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7512
         * 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
  7513
         * a trivial reject is possible, if all objects are newbees.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7514
         * as a side effect, gather min/max addresses
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7515
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7516
        if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7517
            int allNewBees = 1;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7518
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7519
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7520
            minAddr = (char *)(__ArrayInstPtr(aCollection)->a_element[0]);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7521
            maxAddr = minAddr;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7522
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7523
            for (i=0; i<nObjs; i++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7524
                OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7525
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7526
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7527
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7528
                if (__isNonNilObject(anObject)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7529
                    int spc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7530
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7531
                    if (((spc = __qSpace(anObject)) != NEWSPACE) && (spc != SURVSPACE)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7532
                        allNewBees = 0;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7533
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7534
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7535
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7536
                if ((char *)anObject < minAddr) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7537
                    minAddr = (char *)anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7538
                } else if ((char *)anObject > maxAddr) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7539
                    maxAddr = (char *)anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7540
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7541
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7542
            if (allNewBees) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7543
                RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7544
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7545
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7546
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7547
        /*
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7548
         * fetch min/max in searchList (if not already done)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7549
         */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7550
        if (minAddr == 0) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7551
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7552
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7553
            for (i=0; i<nObjs; i++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7554
                OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7555
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7556
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7557
                if ((char *)anObject < minAddr) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7558
                    minAddr = (char *)anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7559
                } else if ((char *)anObject > maxAddr) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7560
                    maxAddr = (char *)anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7561
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7562
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7563
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7564
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7565
        cls = __qClass(self);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7566
        if (((char *)cls >= minAddr) && ((char *)cls <= maxAddr)) {
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7567
#if defined(memsrch4)
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7568
            if (memsrch4(__arrayVal(aCollection), (INT)cls, nObjs)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7569
                RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7570
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7571
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7572
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7573
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7574
            for (i=0; i<nObjs; i++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7575
                OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7576
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7577
                anObject = __ArrayInstPtr(aCollection)->a_element[i];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7578
                if (cls == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7579
                    RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7580
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7581
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7582
#endif /* memsrch4 */
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7583
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7584
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7585
        flags = __ClassInstPtr(cls)->c_flags;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7586
        if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7587
            nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7588
        } else {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7589
            nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7590
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7591
        if (! nInsts) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7592
            RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7593
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7594
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7595
        if (nObjs == 1) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7596
            /* better reverse the loop */
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7597
            OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7598
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7599
            anObject = __ArrayInstPtr(aCollection)->a_element[0];
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7600
#if defined(memsrch4)
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7601
            if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7602
                RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7603
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7604
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7605
            for (inst=0; inst<nInsts; inst++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7606
                if ((__InstPtr(self)->i_instvars[inst]) == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7607
                    RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7608
                }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7609
            }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7610
#endif
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7611
            RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7612
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7613
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7614
        for (inst=0; inst<nInsts; inst++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7615
            OBJ instVar = __InstPtr(self)->i_instvars[inst];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7616
            int i;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7617
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7618
            if (((char *)instVar >= minAddr) && ((char *)instVar <= maxAddr)) {
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7619
#if defined(memsrch4)
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7620
                if (memsrch4(__arrayVal(aCollection), (INT)instVar, nObjs)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7621
                    RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7622
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7623
#else
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7624
                for (i=0; i<nObjs; i++) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7625
                    OBJ anObject;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7626
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7627
                    anObject = __ArrayInstPtr(aCollection)->a_element[i];
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7628
                    if (instVar == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7629
                        RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7630
                    }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7631
                }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7632
#endif /* memsrch4 */
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7633
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7634
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7635
        RETURN (false);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7636
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7637
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7638
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7639
    aCollection do:[:el |
8555
2bff17ee9c22 Use #referencesObject instead of #references:
Stefan Vogel <sv@exept.de>
parents: 8546
diff changeset
  7640
        (self referencesObject:el) ifTrue:[^ true].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7641
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7642
    ^ false
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
referencesDerivedInstanceOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7646
    "return true, if the receiver refers to an instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7647
     the argument, aClass or its subclass. This method exists
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7648
     to support searching for users of a class."
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
    |myClass 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7651
     numInst "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7652
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7653
    "check the class"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7654
    (self isKindOf:aClass) ifTrue:[^ true].
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7655
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7656
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7657
    "check the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7658
    numInst := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7659
    1 to:numInst do:[:i | 
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7660
        ((self instVarAt:i) isKindOf:aClass) ifTrue:[^ true]
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7663
    "check the indexed variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7664
    myClass isVariable ifTrue:[
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7665
        myClass isPointers ifFalse:[
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7666
            "no need to search in non pointer fields"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7667
            ((aClass == Number) or:[aClass isSubclassOf:Number]) ifFalse:[^ false].
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7668
        ].
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7669
        numInst := self basicSize.
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7670
        1 to:numInst do:[:i | 
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7671
            ((self basicAt:i) isKindOf:aClass) ifTrue:[^ true]
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  7672
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7673
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7674
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7675
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7676
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7677
     (1 @ 3.4) referencesDerivedInstanceOf:Number  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7678
     (1 @ 3.4) referencesDerivedInstanceOf:Array   
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7679
     View new initialize referencesDerivedInstanceOf:DeviceWorkstation  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7680
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7681
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7682
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7683
referencesForWhich:checkBlock do:actionBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7684
    |myClass inst
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7685
     numInst "{ Class: SmallInteger }" |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7686
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7687
    myClass := self class.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7688
    "check the instance variables"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7689
    numInst := myClass instSize.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7690
    1 to:numInst do:[:i | 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7691
        inst := self instVarAt:i.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7692
        (checkBlock value:inst) ifTrue:[actionBlock value:inst].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7693
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7694
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7695
    "check the indexed variables"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7696
    myClass isVariable ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7697
        myClass isPointers ifTrue:[
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7698
            "no need to search in non pointer fields"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7699
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7700
            numInst := self basicSize.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7701
            1 to:numInst do:[:i | 
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7702
                inst := self basicAt:i.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7703
                (checkBlock value:inst) ifTrue:[actionBlock value:inst].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7704
            ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7705
        ]
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7706
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7707
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7708
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7709
     (1 @ 3.4) referencesForWhich:[:i | i isFloat] do:[:i | Transcript showCR:i]  
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7710
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7711
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  7712
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7713
referencesInstanceOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7714
    "return true, if the receiver refers to an instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7715
     the argument, aClass.This method exists
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7716
     to support searching for users of a class."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7717
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7718
    |myClass 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7719
     numInst "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7720
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7721
    myClass := self class.
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
    "check the class"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7724
    (myClass isMemberOf:aClass) ifTrue:[^ true].
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
    "check the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7727
    numInst := myClass instSize.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7728
    1 to:numInst do:[:i | 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7729
        ((self instVarAt:i) isMemberOf:aClass) ifTrue:[^ true]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7730
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7731
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7732
    "check the indexed variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7733
    myClass isVariable ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7734
        myClass isPointers ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7735
            "no need to search in non-pointer indexed fields"
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7736
            myClass isLongs ifTrue:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7737
                (aClass == SmallInteger or:[aClass == LargeInteger]) ifFalse:[^ false].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7738
            ] ifFalse:[
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7739
                myClass isFloatsOrDoubles ifTrue:[^ aClass == Float].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7740
                ^ aClass == SmallInteger
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7741
            ]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7742
        ].
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7743
        numInst := self basicSize.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7744
        1 to:numInst do:[:i | 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7745
            ((self basicAt:i) isMemberOf:aClass) ifTrue:[^ true]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7746
        ]
5755
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
    ^ false
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
     (1 @ 3.4) referencesInstanceOf:Float     
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7752
     (1 @ 3.4) referencesInstanceOf:Fraction    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7753
     View new initialize referencesInstanceOf:(Display class)  
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7754
    "
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7755
!
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7756
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7757
referencesObject:anObject
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7758
    "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
  7759
     - for debugging only"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7760
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7761
%{  /* NOCONTEXT */
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7762
    OBJ cls, flags;
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7763
    int nInsts, i;
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7764
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7765
    if (! __isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7766
        RETURN (false);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7767
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7768
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7769
    /*
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7770
     * 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
  7771
     * 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
  7772
     * 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
  7773
     */
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7774
    if (__isNonNilObject(anObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7775
        if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7776
            int spc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7777
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7778
            if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7779
                RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7780
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7781
        }
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7782
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7783
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7784
    cls = __qClass(self);
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7785
    if (cls == anObject) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7786
        RETURN (true);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7787
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7788
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7789
    flags = __ClassInstPtr(cls)->c_flags;
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7790
    if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7791
        nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7792
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7793
        nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7794
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7795
    if (! nInsts) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7796
        RETURN (false);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7797
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7798
#if defined(memsrch4)
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7799
    if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7800
        RETURN (true);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7801
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7802
#else
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7803
    for (i=0; i<nInsts; i++) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7804
        if (__InstPtr(self)->i_instvars[i] == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7805
            RETURN (true);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7806
        }
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7807
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7808
#endif /* memsrch4 */
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7809
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7810
%}.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7811
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7812
"/    |myClass 
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7813
"/     numInst "{ Class: SmallInteger }" |
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7814
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7815
"/    myClass := self class.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7816
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7817
"/    "check the class"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7818
"/    (myClass == anObject) ifTrue:[^ true].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7819
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7820
"/    "check the instance variables"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7821
"/    numInst := myClass instSize.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7822
"/    1 to:numInst do:[:i | 
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7823
"/      ((self instVarAt:i) == anObject) ifTrue:[^ true]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7824
"/    ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7825
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7826
"/    "check the indexed variables"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7827
"/    myClass isVariable ifTrue:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7828
"/      myClass isPointers ifFalse:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7829
"/          "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7830
"/          "/ 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
  7831
"/          "/ 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
  7832
"/          "/ 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
  7833
"/          "/ 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
  7834
"/          "/ 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
  7835
"/          "/ 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
  7836
"/          "/ 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
  7837
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7838
"/          ^ false.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7839
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7840
"/          "/ alternative:
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7841
"/          "/  anObject isNumber ifFalse:[^ false].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7842
"/      ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7843
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7844
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7845
"/      "/ 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
  7846
"/      "/ idenitytIndex method, use it
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7847
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7848
"/      myClass == Array ifTrue:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7849
"/          ^ (self identityIndexOf:anObject) ~~ 0
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7850
"/      ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7851
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7852
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7853
"/      "/ otherwise, do it the slow way
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7854
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7855
"/      numInst := self basicSize.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7856
"/      1 to:numInst do:[:i | 
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7857
"/          ((self basicAt:i) == anObject) ifTrue:[^ true]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7858
"/      ]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7859
"/    ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7860
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7861
    ^ false
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7862
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7863
    "
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7864
     |v|
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7865
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7866
     v := View new initialize.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7867
     v references:Display. 
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  7868
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7869
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7870
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7871
!Object methodsFor:'synchronized evaluation'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7872
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7873
freeSynchronizationSemaphore    
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7874
    "free synchronizationSemaphore. May be used, to save memory when
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7875
     an object is no longer used synchronized."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7876
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7877
    |sema|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7878
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7879
    sema := self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7880
    sema notNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7881
        sema wait.              "/ get lock
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7882
        self synchronizationSemaphore:nil.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7883
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7884
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7885
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7886
     self synchronized:[].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7887
     self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7888
     self freeSynchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7889
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7890
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7891
    "Created: 28.1.1997 / 19:31:20 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7892
    "Modified: 28.1.1997 / 19:47:55 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7893
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7894
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7895
synchronizationSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7896
    "return the synchronization semaphore for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7897
     subclasses may redefine"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7898
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7899
    ^ SynchronizationSemaphores at:self ifAbsent:[].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7900
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7901
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7902
      self synchronizationSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7903
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7904
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7905
    "Modified: 28.1.1997 / 19:47:09 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7906
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7907
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7908
synchronizationSemaphore:aSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7909
    "set the synchronisationSemaphore for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7910
     subclasses may redefine this method"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7911
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7912
    aSemaphore isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7913
        "/ remove Semaphore
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7914
        SynchronizationSemaphores removeKey:self ifAbsent:nil.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7915
    ] ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  7916
        SynchronizationSemaphores at:self put:aSemaphore.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7917
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7918
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7919
    "Modified: 28.1.1997 / 19:37:48 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7920
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7921
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7922
synchronized:aBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7923
    "evaluate aBlock synchronized, i.e. use a monitor for this object"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7924
6600
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7925
    |sema wasBlocked|
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7926
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7927
    wasBlocked := OperatingSystem blockInterrupts.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7928
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7929
    sema := self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7930
    sema isNil ifTrue:[
8481
d12d202b6ddb Set name of synchronization sema
Stefan Vogel <sv@exept.de>
parents: 8441
diff changeset
  7931
        sema := RecursionLock new name:self className.
6600
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7932
        self synchronizationSemaphore:sema.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7933
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7934
6600
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  7935
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
7211
87f5d25b5c3d Make synchronizationSemaphore a recursionLock
Stefan Vogel <sv@exept.de>
parents: 7208
diff changeset
  7936
    sema critical:aBlock.
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7939
       [Object synchronized:[Delay waitForSeconds:2. Transcript showCR:'1']] fork.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7940
       [Object synchronized:[Delay waitForSeconds:2. Transcript showCR:'2']] fork.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7941
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7942
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7943
    "Created: 28.1.1997 / 17:52:56 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7944
    "Modified: 30.1.1997 / 13:38:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7945
    "Modified: 20.2.1997 / 09:43:35 / stefan"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7948
!Object methodsFor:'system primitives'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7949
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7950
asOop
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7951
    "ST-80 compatibility:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7952
     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
  7953
     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
  7954
     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
  7955
     key, which provides (at least) some identity indication.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7956
     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
  7957
     key of two non-identical objects may be the same.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7958
     You'd better not use it - especially do not misuse it."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7959
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7960
    ^ self identityHash
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
    "Created: 9.11.1996 / 19:09:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7963
    "Modified: 9.11.1996 / 19:16:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7964
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7965
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7966
beImmutable
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7967
    "experimental - not yet usable; do not use"
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7968
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7969
%{  /* NOCONTEXT */
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7970
    if (! __isNonNilObject(self)) {
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7971
        RETURN (self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7972
    }
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7973
    __beImmutable(self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7974
%}
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7975
!
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7976
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7977
beMutable
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7978
    "experimental - not yet usable; do not use"
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7979
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7980
%{  /* NOCONTEXT */
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7981
    if (! __isNonNilObject(self)) {
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7982
        RETURN (self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7983
    }
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7984
    __beMutable(self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7985
%}
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7986
!
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  7987
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7988
become:anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7989
    "make all references to the receiver become references to anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7990
     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
  7991
     This can be a very dangerous operation - be warned.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7992
     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
  7993
     produce many strange effects (think of hashing in Sets, Dictionaries etc.).
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
     This may also be an expensive (i.e. slow) operation, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7996
     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
  7997
     references to the two objects (although the primitive tries hard to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7998
     limit the search, for acceptable performance in most cases). 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7999
     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
  8000
     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
  8001
     returned).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8002
     (notice that #become: is not used heavily by the system 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8003
      - the Collection-classes have been rewritten to not use it.)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8004
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8005
    if (__primBecome(self, anotherObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8006
        RETURN ( self );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8007
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8008
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8009
    self primitiveFailed
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8012
becomeNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8013
    "make all references to the receiver become nil - effectively getting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8014
     rid of the receiver. 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8015
     This can be a very dangerous operation - be warned.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8016
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8017
     This may be an expensive (i.e. slow) operation.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8018
     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
  8019
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
    if (__primBecomeNil(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8022
        RETURN ( nil );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8023
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8024
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8025
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8026
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8027
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8028
becomeSameAs:anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8029
    "make all references to the receiver become references to anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8030
     but NOT vice versa (as done in #become:).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8031
     This can be a very dangerous operation - be warned.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8032
     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
  8033
     produce many strange effects (think of hashing in Sets, Dictionaries etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8034
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8035
     This may also be an expensive (i.e. slow) operation,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8036
     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
  8037
     references to the two objects (although the primitive tries hard to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8038
     limit the search, for acceptable performance in most cases).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8039
     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
  8040
     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
  8041
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8042
    if (__primBecomeSameAs(self, anotherObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8043
        RETURN ( self );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8044
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8045
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8046
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8047
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8048
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8049
changeClassTo:otherClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8050
    "changes the class of the receiver to the argument, otherClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8051
     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
  8052
     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
  8053
     type of indexed instance variables). 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8054
     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
  8055
     is UndefinedObject or a Smallinteger, a primitive error is triggered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8056
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8057
    |myClass ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8058
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8059
    "check for UndefinedObject/SmallInteger receiver or newClass"
7202
85178c4cefe0 ensure that other class is autoloaded in changeClassTo:
penk
parents: 7177
diff changeset
  8060
    otherClass autoload.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8061
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8062
    {
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8063
        OBJ other = otherClass;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8064
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8065
        if (__isNonNilObject(self) 
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8066
         && __isNonNilObject(other)
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8067
         && (other != UndefinedObject)
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8068
         && (other != SmallInteger)) {
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8069
            ok = true;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8070
        } else {
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8071
            ok = false;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8072
        }
5755
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
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8075
    ok ifTrue:[
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8076
        ok := false.
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8077
        myClass := self class.
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8078
        myClass flags == otherClass flags ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8079
            myClass instSize == otherClass instSize ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8080
                "same instance layout and types: its ok to do it"
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8081
                ok := true.
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8082
            ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8083
                myClass isPointers ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8084
                    myClass isVariable ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8085
                        ok := true
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8086
                    ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8087
                ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8088
            ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8089
        ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8090
            myClass isPointers ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8091
                "if newClass is a variable class, with instSize <= my instsize,
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8092
                 we can do it (effectively mapping additional instvars into the
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8093
                 variable part) - usefulness is questionable, though"
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8094
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8095
                otherClass isPointers ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8096
                    otherClass isVariable ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8097
                        otherClass instSize <= (myClass instSize + self basicSize) 
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8098
                        ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8099
                            ok := true
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8100
                        ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8101
                    ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8102
                        otherClass instSize == (myClass instSize + self basicSize) 
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8103
                        ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8104
                            ok := true
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8105
                        ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8106
                    ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8107
                ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8108
                    "it does not make sense to convert pointers to bytes ..."
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8109
                ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8110
            ] ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8111
                "does it make sense, to convert bits ?"
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8112
                "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8113
                (myClass isBitsExtended and:[otherClass isBitsExtended]) ifTrue:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8114
                    ok := true
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8115
                ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8116
            ]
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8117
        ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8118
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8119
    ok ifTrue:[
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8120
        "now, change the receivers class ..."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8121
%{
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8122
        {
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8123
            OBJ me = self;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8124
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8125
            __qClass(me) = otherClass;
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8126
            __STORE(me, otherClass);
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8127
            RETURN (me);
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8128
        }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8129
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8130
    ].
6533
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8131
    otherClass isLoaded ifFalse:[
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8132
        ^ self changeClassTo:(otherClass autoload).
8396a7332890 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6517
diff changeset
  8133
    ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8134
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8135
     the receiver cannot be represented as a instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8136
     the desired class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8137
     For example, you cannot change a bitInstance (byteArray etc.) 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8138
     into a pointer object and vice versa.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8139
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8140
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8141
!
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
changeClassToThatOf:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8144
    "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
  8145
     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
  8146
     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
  8147
     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
  8148
     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
  8149
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8150
    self changeClassTo:(anObject class)
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8151
!
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8152
8935
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8153
isImmutable
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8154
    "experimental - not yet usable; do not use"
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8155
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8156
%{  /* NOCONTEXT */
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8157
    if (! __isNonNilObject(self)) {
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8158
        RETURN (true);
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8159
    }
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8160
    RETURN (__isImmutable(self) ? true : false);
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8161
%}
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8162
!
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8163
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8164
replaceReferencesTo:anObject with:newRef
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8165
    "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
  8166
     Return true, if any reference was changed.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8167
     Notice: this does not change the class-reference."
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8168
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8169
%{  /* NOCONTEXT */
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8170
    OBJ cls, flags, anyChange;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8171
    int nInsts, i;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8172
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8173
    if (! __isNonNilObject(self)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8174
        RETURN (false);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8175
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8176
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8177
    /*
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8178
     * a little optimization: use the fact that all old objects
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8179
     * 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
  8180
     * a trivial reject is possible, if anObject is a newbee
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8181
     */
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8182
    if (__isNonNilObject(anObject)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8183
        if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8184
            int spc;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8185
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8186
            if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8187
                RETURN (false);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8188
            }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8189
        }
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8190
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8191
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8192
    cls = __qClass(self);
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8193
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8194
    flags = __ClassInstPtr(cls)->c_flags;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8195
    if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8196
        nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8197
    } else {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8198
        nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8199
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8200
    if (! nInsts) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8201
        RETURN (false);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8202
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8203
    anyChange = false;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8204
    for (i=0; i<nInsts; i++) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8205
        if (__InstPtr(self)->i_instvars[i] == anObject) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8206
            __InstPtr(self)->i_instvars[i] = newRef;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8207
            __STORE(self, newRef);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8208
            anyChange = true;
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8209
        }
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8210
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8211
    RETURN (anyChange);
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8212
%}.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8213
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8214
    "
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8215
     |v|
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8216
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8217
     v := Array with:1234 with:'hello' with:Array.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8218
     v replaceReferencesTo:Array with:ByteArray.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8219
     v inspect
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8220
    "
5755
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
!Object methodsFor:'testing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8224
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8225
? defaultValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8226
     "a syntactic shugar-piece:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8227
      if the receiver is nil, return the defaultValue;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8228
      otherwise, return the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8229
      This method is only redefined in UndefinedObject - therefore,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8230
      the recevier is retuned here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8231
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8232
      Thus, if foo and bar are simple variables or constants,
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8233
          foo ? bar
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8234
      is the same as:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8235
          (foo isNil ifTrue:[bar] ifFalse:[foo])
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8236
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8237
      if they are message sends, the equivalent code is:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8238
          [
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8239
              |t1 t2|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8240
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8241
              t1 := foo.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8242
              t2 := bar.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8243
              t1 isNil ifTrue:[t2] ifFalse:[t1]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8244
          ] value
5755
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
      Can be used to provide defaultValues to variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8247
      as in:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8248
          foo := arg ? #defaultValue
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8249
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8250
      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
  8251
      Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8252
         This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8253
         - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8254
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8255
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8256
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8257
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8258
     1 ? #default
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8259
     nil ? #default
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8260
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8261
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8262
    "Created: / 4.11.1996 / 20:36:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8263
    "Modified: / 19.5.1998 / 17:39:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8264
!
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
?? defaultValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8267
     "a syntactic shugar-piece:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8268
      much like ?, but sends #value to the argument if required.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8269
      (i.e. its the same as #ifNil:)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8270
      If the receiver is nil, return the defaultValues value;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8271
      otherwise, return the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8272
      This method is only redefined in UndefinedObject - therefore,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8273
      the recevier is retuned here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8274
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8275
      Thus, if foo and bar are simple variables or constants,
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8276
          foo ?? bar
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8277
      is the same as:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8278
          (foo isNil ifTrue:[bar value] ifFalse:[foo])
5755
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
      if they are message sends, the equivalent code is:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8281
          [
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8282
              |t t2|
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8283
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8284
              t := foo.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8285
              t isNil ifTrue:[bar value] ifFalse:[t]
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8286
          ] value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8287
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8288
      Can be used to provide defaultValues to variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8289
      as in:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8290
          foo := arg ?? [ self computeDefault ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8291
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8292
      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
  8293
     "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8294
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8295
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8296
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8297
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8298
     1 ?? #default 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8299
     nil ?? #default
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8300
     1 ?? [ self halt. 1 + 2 ] 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8301
     nil ?? [ self halt. 1 + 2 ] 
6069
9aff12a37f5e comment
Claus Gittinger <cg@exept.de>
parents: 6068
diff changeset
  8302
     1 ?? [Date today]   
9aff12a37f5e comment
Claus Gittinger <cg@exept.de>
parents: 6068
diff changeset
  8303
     nil ?? [Date today]  
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8304
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8305
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8306
    "Created: / 4.11.1996 / 20:36:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8307
    "Modified: / 19.5.1998 / 17:42:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8308
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8309
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8310
ifNil:aBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8311
    "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
  8312
     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
  8313
     receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8314
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8315
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8316
        - redefining it may not work as expected."
5755
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
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8319
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8320
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8321
ifNil:nilBlockOrValue ifNotNil:notNilBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8322
    "return the value of the first arg, if I am nil,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8323
     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
  8324
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8325
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8326
        - redefining it may not work as expected."
5755
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
    ^ notNilBlockOrValue value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8329
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8330
!
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
ifNotNil:aBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8333
    "return myself if nil, or the result from evaluating the argument, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8334
     if I am not nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8335
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8336
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8337
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8338
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8339
    ^ aBlockOrValue value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8340
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8343
ifNotNil:notNilBlockOrValue ifNil:nilBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8344
    "return the value of the 2nd arg, if I am nil,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8345
     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
  8346
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8347
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8348
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8349
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8350
    ^ notNilBlockOrValue value
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
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
8574
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8355
ifNotNilDo:aBlock
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8356
    "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
  8357
     Otherwise do nothing and return nil."
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8358
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8359
    ^ aBlock value:self
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8360
!
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  8361
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8362
isArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8363
    "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
  8364
     false is returned here - the method is only redefined in Array."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8365
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8366
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8367
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8368
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8369
isAssociation
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8370
    "return true, if the receiver is some kind of association;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8371
     false is returned here - the method is only redefined in Association."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8372
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8373
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8374
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8375
    "Created: 14.5.1996 / 17:03:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8376
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8377
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8378
isBehavior
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8379
    "return true, if the receiver is describing another objects behavior.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8380
     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
  8381
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8382
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8383
!
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
isBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8386
    "return true, if the receiver is some kind of block;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8387
     false returned here - the method is only redefined in Block."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8388
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8389
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8390
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8391
5824
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8392
isBoolean
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8393
    "return true, if the receiver is a boolean;
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8394
     false is returned here - the method is only redefined in Boolean."
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8395
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8396
    ^ false
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8397
!
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  8398
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8399
isByteArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8400
    "return true, if the receiver is some kind of bytearray;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8401
     false is returned here - the method is only redefined in ByteArray."
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
    ^ 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
8986
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8406
isByteCollection
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8407
    "return true, if the receiver is some kind of byte collection,
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8408
     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
  8409
     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
  8410
    
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8411
     false is returned here - the method is only redefined in UninterpretedBytes."
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8412
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8413
    ^ false
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8414
!
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  8415
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8416
isCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8417
    "return true, if the receiver is some kind of character;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8418
     false is returned here - the method is only redefined in Character."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8419
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8420
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8421
!
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
isClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8424
    "return true, if the receiver is some kind of class (real class, 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8425
     not just behavior);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8426
     false is returned here - the method is only redefined in Class."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8427
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8428
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8429
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8430
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8431
isCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8432
    "return true, if the receiver is some kind of collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8433
     false is returned here - the method is only redefined in Collection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8434
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8435
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8436
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8437
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8438
isColor
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8439
    "return true, if the receiver is some kind of color;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8440
     false is returned here - the method is only redefined in Color."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8441
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8442
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8443
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8444
6567
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8445
isCons
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8446
    "return true, if the receiver is a cons (pair);
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8447
     false is returned here - the method is only redefined in Cons."
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8448
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8449
    ^ false
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8450
!
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8451
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8452
isContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8453
    "return true, if the receiver is some kind of context;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8454
     false returned here - the method is only redefined in Context."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8455
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8456
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8457
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8458
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8459
isEmptyOrNil
8833
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8460
    "return true if I am nil or an empty collection - return false here.
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8461
     (from Squeak)"
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8462
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8463
    ^ false
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8464
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8465
    "Created: / 13.11.2001 / 13:17:04 / cg"
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  8466
    "Modified: / 13.11.2001 / 13:28:40 / cg"
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8467
!
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  8468
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8469
isException
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8470
    "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
  8471
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8472
    ^ false
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8473
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8474
    "Created: / 17.11.2001 / 18:37:44 / cg"
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8475
!
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  8476
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8477
isExceptionCreator
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8478
    "return true, if the receiver can create exceptions,
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8479
     this includes #raise, #raiseRequest as well as the behavior of
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8480
     an exception handler, such as the #accepts: and #handles: messages"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8481
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8482
    ^ false
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8483
!
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8484
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8485
isExceptionHandler
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8486
    "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
  8487
     especially to the #accepts: and #handles: messages"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8488
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8489
    ^ false
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8490
!
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8491
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8492
isExternalStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8493
    "return true, if the receiver is some kind of externalStream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8494
     false is returned here - the method is only redefined in ExternalStream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8495
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8496
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8497
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8498
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8499
isFileStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8500
    "return true, if the receiver is some kind of fileStream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8501
     false is returned here - the method is only redefined in FileStream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8502
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8503
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8504
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8505
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8506
isFilename
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8507
    "return true, if the receiver is some kind of filename;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8508
     false is returned here - the method is only redefined in Filename."
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
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8511
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8512
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8513
isFixedPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8514
    "return true, if the receiver is some kind of fixedPoint number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8515
     false is returned here - the method is only redefined in FixedPoint."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8516
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8517
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8518
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8519
    "Created: 5.11.1996 / 19:23:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8520
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8521
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8522
isFixedSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8523
    "return true if the receiver cannot grow easily 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8524
     (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
  8525
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8526
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8527
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8528
6185
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8529
isFloat
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8530
    "return true, if the receiver is some kind of floating point number;
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8531
     false is returned here.
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8532
     Same as #isLimitedPrecisionReal, but a better name ;-)"
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8533
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8534
    ^ false
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8535
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8536
    "Modified: / 14.11.2001 / 14:57:46 / cg"
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8537
!
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  8538
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8539
isForm
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8540
    "return true, if the receiver is some kind of form;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8541
     false is returned here - the method is only redefined in Form."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8542
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8543
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8544
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8545
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8546
isFraction
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8547
    "return true, if the receiver is some kind of fraction;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8548
     false is returned here - the method is only redefined in Fraction."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8549
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8550
    ^ false
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
9293
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8553
isHierarchicalItem
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8554
    "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
  8555
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8556
    ^ false
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8557
!
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  8558
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8559
isImage
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8560
    "return true, if the receiver is some kind of image;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8561
     false is returned here - the method is only redefined in Image."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8562
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8563
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8564
!
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
isImageOrForm
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8567
    "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
  8568
     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
  8569
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8570
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8571
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8572
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8573
isImmediate
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8574
    "return true if I am an immediate object
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8575
     i.e. I am represented in the pointer itself and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8576
     no real object header/storage is used me.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8577
     (currently, only SmallIntegers, some characters and nil return true)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8578
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8579
    ^ self class hasImmediateInstances
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8580
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8581
    "Created: 3.6.1997 / 12:00:18 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8582
!
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
isInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8585
    "return true, if the receiver is some kind of integer number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8586
     false is returned here - the method is only redefined in Integer."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8587
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8588
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8589
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8590
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8591
isInterestConverter
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8592
    "return true if I am a kind of interest forwarder"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8593
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8594
    ^ false
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8595
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8596
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8597
isJavaClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8598
    "return true, if this is a javaClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8599
     false is returned here - the method is only redefined in JavaClass."
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
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8602
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8603
    "Created: / 26.3.1997 / 13:34:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8604
    "Modified: / 8.5.1998 / 21:25:21 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8605
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8606
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8607
isJavaClassRef
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8608
    "return true, if this is a JavaClassRef.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8609
     false is returned here - the method is only redefined in JavaClassRef."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8610
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8611
    ^ false
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
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8614
    "Created: / 24.12.1999 / 01:46:28 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8615
!
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
isJavaContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8618
    "return true, if this is a javaContext.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8619
     false is returned here - the method is only redefined in JavaContext."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8620
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8621
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8622
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8623
    "Created: / 8.5.1998 / 21:24:27 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8624
    "Modified: / 8.5.1998 / 21:25:35 / cg"
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
isJavaMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8628
    "return true, if this is a JavaMethod.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8629
     false is returned here - the method is only redefined in JavaMethod."
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
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8634
    "Created: / 25.9.1999 / 23:26:12 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8635
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8636
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8637
isJavaMethodRef
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8638
    "return true, if this is a JavaMethodRef.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8639
     false is returned here - the method is only redefined in JavaMethodRef."
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
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8642
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8643
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8644
    "Created: / 23.12.1999 / 19:44:51 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8645
!
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
isJavaObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8648
    "return true, if this is a javaObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8649
     false is returned here - the method is only redefined in JavaObject."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8650
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8651
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8652
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8653
    "Created: / 26.3.1997 / 13:34:48 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8654
    "Modified: / 8.5.1998 / 21:25:46 / cg"
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
isJavaScriptClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8658
    "return true, if this is a javaScriptClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8659
     false is returned here - the method is only redefined in JavaScriptClass."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8660
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8661
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8662
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8663
8935
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8664
isJavaScriptMetaclass
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8665
    "return true, if this is a javaScript Metaclass.
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8666
     false is returned here - the method is only redefined in JavaScriptMetaclass."
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8667
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8668
    ^ false
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8669
!
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8670
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8671
isKindOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8672
    "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
  8673
     subclasses, false otherwise.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8674
     Advice: 
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8675
        use of this to check objects for certain attributes/protocoll should
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8676
        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
  8677
        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
  8678
        hierarchy.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8679
        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
  8680
        (such as #isXXXX, #respondsTo: or #isNumber).
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8681
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8682
        Using #isKindOf: is considered BAD STYLE.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8683
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8684
     Advice2:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8685
        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
  8686
        using #isKindOf:; because isKindOf: has to walk up all the superclass 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8687
        hierarchy, comparing every class on the way. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8688
        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
  8689
        a single function call.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8690
     "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8691
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8692
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8693
    register OBJ thisClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8694
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8695
    thisClass = __Class(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8696
    while (thisClass != nil) {
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8697
        if (thisClass == aClass) {
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8698
            RETURN ( true );
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8699
        }
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8700
        thisClass = __ClassInstPtr(thisClass)->c_superclass;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8701
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8702
    RETURN ( false );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8703
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8704
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
"/  the above code is equivalent to:
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
"/  thisClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8709
"/  [thisClass notNil] whileTrue:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8710
"/      thisClass == aClass ifTrue:[^ true].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8711
"/      thisClass := thisClass superclass
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
"/  ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8714
"/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8715
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8716
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8717
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8718
isLayout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8719
    "return true, if the receiver is some kind of layout;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8720
     false is returned here - the method is only redefined in Layout."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8721
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8722
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8723
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8724
6567
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8725
isLazyValue
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8726
    ^ false
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8727
!
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  8728
6086
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8729
isLimitedPrecisionReal
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8730
    "return true, if the receiver is some kind of floating point number;
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8731
     false is returned here - the method is only redefined in LimitedPrecisionReal."
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8732
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8733
    ^ false
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8734
!
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  8735
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8736
isList
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8737
    "return true, if the receiver is some kind of list collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8738
     false is returned here - the method is only redefined in List."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8739
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8740
    ^ false
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
    "Created: / 11.2.2000 / 01:37:05 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8745
isLiteral
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8746
    "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
  8747
     false is returned here - the method is redefined in some classes."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8748
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8749
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8750
!
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
isMemberOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8753
    "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
  8754
     Advice: 
8833
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8755
        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
  8756
        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
  8757
        to instances of a certain class.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8758
        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
  8759
        (such as #isXXX, #respondsTo: or #isNumber);
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8760
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8761
        Using #isMemberOf: is considered BAD STYLE.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8762
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8763
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8764
        - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8765
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8766
    ^ (self class) == aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8767
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8768
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8769
isMeta
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8770
    "return true, if the receiver is some kind of metaclass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8771
     false is returned here - the method is only redefined in Metaclass."
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
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8774
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8775
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8776
isMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8777
    "return true, if the receiver is some kind of method;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8778
     false returned here - the method is only redefined in Method."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8779
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8780
    ^ false
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8783
isMorph
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8784
    "return true, if the receiver is some kind of morph;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8785
     false is returned here - the method is only redefined in Morph."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8786
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8787
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8788
!
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
isNameSpace
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8791
    "return true, if the receiver is a nameSpace.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8792
     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
  8793
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8794
    ^ false
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
    "Created: / 11.10.1996 / 18:08:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8797
    "Modified: / 8.5.1998 / 21:26:05 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8800
isNamespace
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8801
    "return true, if this is a nameSpace.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8802
     false is returned here - the method is only redefined in Namespace."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8803
5869
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  8804
    <resource:#obsolete>
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  8805
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8806
    self obsoleteMethodWarning:'use #isNameSpace'.
6805
f95ad1a82775 *** empty log message ***
ca
parents: 6800
diff changeset
  8807
    ^ self isNameSpace
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8808
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8809
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8810
isNil
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8811
    "Return true, if the receiver is nil.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8812
     Because isNil is redefined in UndefinedObject,
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8813
     the receiver is definitely not nil here, so unconditionally return false.
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8814
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8815
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8816
        - redefining it may not work as expected."
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8817
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8818
    ^ false
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8819
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8820
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8821
isNilOrEmptyCollection
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  8822
    "return true if I am nil or an empty collection - false here.
8833
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8823
     Obsolete, use isEmptyOrNil."
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8824
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  8825
    <resource:#obsolete>
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8826
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8827
    ^ false
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  8828
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  8829
    "Modified: / 13.11.2001 / 13:28:06 / cg"
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8830
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8831
9005
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8832
isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8833
    "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
  8834
     false is returned here - the method is redefined in Collection and UninterpretedBytes."
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8835
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8836
    ^ false
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8837
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8838
    "
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8839
        21 isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8840
        'abc' isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8841
        #'abc' isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8842
        #[1 2 3] isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8843
        #(1 2 3) isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8844
    "
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8845
!
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  8846
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8847
isNumber
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8848
    "return true, if the receiver is some kind of number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8849
     false is returned here - the method is only redefined in Number."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8850
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8851
    ^ false
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8854
isOrderedCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8855
    "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
  8856
     false is returned here - the method is only redefined in OrderedCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8857
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8858
    ^ false
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8861
isPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8862
    "return true, if the receiver is some kind of point;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8863
     false is returned here - the method is only redefined in Point."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8864
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8865
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8866
!
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
isRectangle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8869
    "return true, if the receiver is some kind of rectangle;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8870
     false is returned here - the method is only redefined in Rectangle."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8871
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8872
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8873
!
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
isRemoteObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8876
    "return true, if the receiver is some kind of remoteObject,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8877
     false if its local - the method is only redefined in RemoteObject."
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
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8880
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8881
    "Created: 28.10.1996 / 15:18:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8882
    "Modified: 28.10.1996 / 15:20:57 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8883
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8884
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8885
isSequenceable
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8886
    "return true, if the receiver is some kind of sequenceable collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8887
     false is returned here - the method is only redefined in SequenceableCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8888
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8889
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8890
!
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
isSequenceableCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8893
    "OBSOLETE: use isSequenceable for ST-80 compatibility.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8894
     This method is a historic leftover and will be removed soon ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8895
     (although its name is much better than #isSequenceable - sigh)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8896
5869
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  8897
    <resource:#obsolete>
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  8898
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8899
    self obsoleteMethodWarning:'use #isSequenceable'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8900
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8901
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8902
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8903
isStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8904
    "return true, if the receiver is some kind of stream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8905
     false is returned here - the method is only redefined in Stream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8906
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8907
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8908
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8909
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8910
isString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8911
    "return true, if the receiver is some kind of string;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8912
     false is returned here - the method is only redefined in CharacterArray."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8913
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8914
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8915
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8916
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8917
isStringCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8918
    "return true, if the receiver is some kind of stringCollection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8919
     false is returned here - the method is only redefined in StringCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8920
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8921
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8922
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8923
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8924
isSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8925
    "return true, if the receiver is some kind of symbol;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8926
     false is returned here - the method is only redefined in Symbol."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8927
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8928
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8929
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8930
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8931
isText
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8932
    "return true, if the receiver is some kind of text object;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8933
     false is returned here - the method is only redefined in Text."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8934
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8935
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8936
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8937
    "Created: 12.5.1996 / 10:56:50 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8938
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8939
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8940
isValueModel
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8941
    "return true, if the receiver is some kind of valueModel;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8942
     false is returned here - the method is only redefined in ValueModel."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8943
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8944
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8945
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8946
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8947
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8948
isVariable
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8949
    "return true if the receiver has indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8950
     false otherwise."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8951
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8952
    ^ self class isVariable
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
isVariableBinding
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8956
    "return true, if this is a binding for a variable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8957
     false is returned here - the method is only redefined in Binding."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8958
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8959
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8960
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8961
    "Created: / 19.6.1997 / 17:38:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8962
    "Modified: / 8.5.1998 / 21:26:55 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8963
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8964
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8965
isView
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8966
    "return true, if the receiver is some kind of view;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8967
     false is returned here - the method is only redefined in View."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8968
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8969
    ^ false
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8970
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8971
6932
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8972
notEmptyOrNil
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8973
    "Squeak compatibility:
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8974
     return true if I am neither nil nor an empty collection.
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8975
     Return true here."
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8976
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8977
    ^ true
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8978
!
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  8979
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8980
notNil
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8981
    "Return true, if the receiver is not nil.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8982
     Because notNil is redefined in UndefinedObject,
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  8983
     the receiver is definitely not nil here, so unconditionally return true.
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8984
     Notice:
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8985
        This method is open coded (inlined) by the compiler(s)
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  8986
        - redefining it may not work as expected."
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8987
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  8988
    ^ true
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
!Object methodsFor:'tracing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8992
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8993
traceInto:aRequestor level:level from:referrer
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8994
    "double dispatch into tracer, passing my type implicitely in the selector"
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
    ^ aRequestor traceObject:self level:level from:referrer
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8997
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8998
    "Created: / 2.9.1999 / 09:05:17 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8999
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9000
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9001
!Object methodsFor:'user interaction & notifications'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9002
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9003
activityNotification:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9004
    "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
  9005
     some long-time activity.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9006
     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
  9007
     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
  9008
     and proceed. If there is no handler, this is simply ignored.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9009
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9010
     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
  9011
     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
  9012
     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
  9013
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  9014
    ActivityNotification isHandled ifTrue:[
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  9015
        ^ ActivityNotification raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9016
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9017
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9018
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9019
     nil activityNotification:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9020
     self activityNotification:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9021
    "
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
    "
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  9024
     ActivityNotification handle:[:ex |
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  9025
        ex errorString printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9026
        ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9027
     ] do:[
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  9028
        'hello' printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9029
        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
  9030
        'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9031
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9032
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9033
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9034
    "Modified: 16.12.1995 / 18:23:42 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9035
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9036
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9037
confirm:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9038
    "launch a confirmer, which allows user to enter yes or no.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9039
     return true for yes, false for no.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9040
     If no GUI is present (headless applications), true is returned."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9041
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9042
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9043
     on systems without GUI, or during startup, output a message
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9044
     and return true (as if yes was answered)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9045
     Q: should we ask user by reading Stdin ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9046
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9047
    Smalltalk isInitialized ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9048
        '*** confirmation requested during initialization:' errorPrintCR. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9049
        aString errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9050
        '*** I''ll continue, assuming <yes> ...' errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9051
        ^ true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9052
    ].
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
    (Dialog isNil 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9055
    or:[Screen isNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9056
    or:[Screen current isNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9057
    or:[Screen current isOpen not]]]) ifTrue:[       
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9058
        'confirm: ' infoPrint.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9059
        aString infoPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9060
        'continue, assuming <yes>' infoPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9061
        ^ true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9062
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9063
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9064
    Dialog autoload.        "in case its autoloaded"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9065
    ^ Dialog confirm:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9066
        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9067
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9068
     nil confirm:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9069
     self confirm:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9070
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9071
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9072
    "Modified: 20.5.1996 / 10:28:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9073
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9074
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9075
confirm:aString orCancel:cancelBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9076
    "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
  9077
     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
  9078
     If no GUI is present (headless applications), cancelBlock is returned."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9079
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9080
    |answer|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9081
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9082
    answer := self confirmWithCancel:aString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9083
    answer isNil ifTrue:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9084
        ^ cancelBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9085
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9086
    ^ answer
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9087
        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9088
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9089
     self confirm:'hello' orCancel:[self halt]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9090
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9091
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9092
    "Modified: 20.5.1996 / 10:28:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9093
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9094
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9095
confirmWithCancel:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9096
    "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
  9097
     return true for yes, false for no, nil for cancel.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9098
     If no GUI is present (headless applications), nil is returned."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9099
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9100
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9101
     on systems without GUI, or during startup, output a message
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9102
     and return true (as if yes was answered)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9103
     Q: should we ask user by reading Stdin ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9104
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9105
    Smalltalk isInitialized ifFalse:[
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9106
        '*** confirmation requested during initialization:' errorPrintCR. 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9107
        aString errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9108
        '*** I''ll continue, assuming <cancel> ...' errorPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9109
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9110
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9111
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9112
    (Dialog isNil 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9113
    or:[Screen isNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9114
    or:[Screen current isNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9115
    or:[Screen current isOpen not]]]) ifTrue:[       
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9116
        'confirm: ' infoPrint.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9117
        aString infoPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9118
        'continue, assuming <cancel>' infoPrintCR.
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9119
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9120
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9121
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9122
    Dialog autoload.        "in case its autoloaded"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9123
    ^ Dialog confirmWithCancel:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9124
        
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9125
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9126
     nil confirmWithCancel:'hello' 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9127
     self confirmWithCancel:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9128
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9129
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9130
    "Modified: 20.5.1996 / 10:28:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9131
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9132
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9133
errorNotify:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9134
    "launch a Notifier, showing top stack, telling user something
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9135
     and give user a chance to enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9136
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9137
    ^ self
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9138
        errorNotify:aString 
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9139
        from:thisContext sender
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9140
        allowDebug:true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9141
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9142
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9143
     nil errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9144
     self errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9145
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9146
6199
5fcf06f17cee *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6196
diff changeset
  9147
    "Modified: / 16.11.2001 / 15:36:49 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9148
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9149
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9150
errorNotify:aString from:aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9151
    "launch a Notifier, showing top stack (above aContext), 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9152
     telling user something and give user a chance to enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9153
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9154
    ^ self errorNotify:aString from:aContext allowDebug:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9155
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9156
    "Modified: / 17.8.1998 / 10:09:27 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9157
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9158
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9159
errorNotify:aString from:aContext allowDebug:allowDebug
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9160
    "launch a Notifier, showing top stack (above aContext), 
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9161
     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
  9162
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9163
    |currentScreen con sender action boxLabels boxValues default|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9164
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9165
    Smalltalk isInitialized ifFalse:[
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9166
        'errorNotification: ' print. aString printCR.
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9167
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9168
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9169
    (Dialog isNil 
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9170
     or:[Screen isNil
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9171
     or:[(currentScreen := Screen current) isNil
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9172
     or:[currentScreen isOpen not]]]) ifTrue:[       
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9173
        "
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9174
         on systems without GUI, simply show
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9175
         the message on the Transcript and abort.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9176
        "
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9177
        Transcript showCR:aString.
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9178
        AbortOperationRequest raise.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9179
        "not reached"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9180
        ^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9181
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9182
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9183
    Processor activeProcessIsSystemProcess ifTrue:[
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9184
        action := #debug.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9185
        sender := aContext.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9186
        Debugger isNil ifTrue:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9187
            '****************** Cought Error while in SystemProcess ****************' errorPrintCR.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9188
            thisContext fullPrintAll.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9189
            action := #abort.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9190
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9191
    ] ifFalse:[
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9192
        Dialog autoload.        "in case it's autoloaded"
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9193
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9194
        Error handle:[:ex |
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9195
            "/ a recursive error - quickly enter debugger
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9196
            "/ this happened, when I corrupted the Dialog class ...
7208
b95620b2c6b6 #errorSignal -> #description
Stefan Vogel <sv@exept.de>
parents: 7204
diff changeset
  9197
            ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR.
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9198
            action := #debug.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9199
            ex return.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9200
        ] do:[ |s|
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9201
            sender := aContext.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9202
            sender isNil ifTrue:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9203
                sender := thisContext sender.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9204
            ].
7576
7e2e97bd0973 interrestingContextFrom - duplicated code removed
Claus Gittinger <cg@exept.de>
parents: 7567
diff changeset
  9205
            con := sender.
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9206
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9207
            "/ skip intermediate (signal & exception) contexts
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9208
            DebugView notNil ifTrue:[
7576
7e2e97bd0973 interrestingContextFrom - duplicated code removed
Claus Gittinger <cg@exept.de>
parents: 7567
diff changeset
  9209
                con := DebugView interestingContextFrom:sender
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9210
            ].
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9211
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9212
            "/ show the first few contexts
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9213
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9214
            s := WriteStream with:aString.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9215
            s cr; cr.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9216
            1 to:15 do:[:n |
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9217
                con notNil ifTrue:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9218
                    con printOn:s.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9219
                    s cr.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9220
                    con := con sender
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9221
                ]
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9222
            ].
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9223
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9224
            (allowDebug and:[Debugger notNil]) ifTrue:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9225
                boxLabels := #('Proceed' 'Abort' 'Copy Trace and Abort' 'Debug').
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9226
                boxValues := #(#proceed  #abort  #copy                  #debug).
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9227
                default := #debug.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9228
            ] ifFalse:[
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9229
                boxLabels := #('Proceed' 'Abort' 'Copy Trace and Abort').
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9230
                boxValues := #(#proceed  #abort  #copy).
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9231
                default := #abort.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9232
            ].
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9233
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9234
            action := Dialog 
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9235
                    choose:s contents 
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9236
                    label:('Exception [' , Processor activeProcess nameOrId , ']')
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9237
                    image:WarningBox errorIconBitmap
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9238
                    labels:boxLabels
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9239
                    values:boxValues
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9240
                    default:default
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9241
                    onCancel:nil.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9242
        ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9243
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9244
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9245
    action == #debug ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9246
        ^ Debugger enter:sender withMessage:aString mayProceed:true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9247
    ] ifFalse:[
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9248
        action == #proceed ifTrue:[
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9249
            ^ nil.
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9250
        ].
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9251
        action == #copy ifTrue:[ |s|
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9252
            s := '' writeStream.
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9253
            sender fullPrintAllOn:s.
8563
9ea42d4571b5 set selection interface changed
ca
parents: 8555
diff changeset
  9254
            currentScreen rootView setClipboardText:s contents.
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
  9255
        ].
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9256
        AbortOperationRequest raise.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9257
        "not reached"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9258
    ].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9259
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9260
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9261
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9262
     nil errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9263
     self errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9264
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9265
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9266
    "Created: / 17.8.1998 / 10:09:26 / cg"
6199
5fcf06f17cee *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6196
diff changeset
  9267
    "Modified: / 16.11.2001 / 15:40:12 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9268
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9269
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9270
information:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9271
    "launch an InfoBox, telling user something. 
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9272
     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
  9273
     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
  9274
     Use #notify: for more important messages.
8371
4493f5ac7405 *** empty log message ***
ca
parents: 8330
diff changeset
  9275
     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
  9276
     pops up a warn dialog."
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9277
7035
1d049fb7ae5a Make UserInformation a class based exception
Stefan Vogel <sv@exept.de>
parents: 7033
diff changeset
  9278
    UserInformation raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9279
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9280
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9281
     nil information:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9282
     self information:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9283
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9284
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9285
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9286
     InformationSignal handle:[:ex |
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9287
        'no box popped' printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9288
        ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9289
     ] do:[
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9290
        'hello' printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9291
        self information:'some info'.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9292
        'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9293
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9294
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9295
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9296
    "Modified: 24.11.1995 / 22:29:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9297
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9298
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9299
notify:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9300
    "launch a Notifier, telling user something.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9301
     Use #information: for ignorable messages.
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9302
     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
  9303
     pops up a warn dialog."
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9304
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9305
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9306
    Smalltalk isInitialized ifFalse:[
6656
e434adf0a1f3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6654
diff changeset
  9307
        "/ thisContext fullPrintAll.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9308
        'information: ' print. aString printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9309
        ^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9310
    ].
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9311
    UserNotification raiseRequestWith:self errorString:aString.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9312
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9313
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9314
     nil notify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9315
     self notify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9316
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9317
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9318
    "Modified: 20.5.1996 / 10:28:48 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9319
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9320
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9321
warn:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9322
    "launch a WarningBox, telling user something.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9323
     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
  9324
     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
  9325
     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
  9326
     pops up a warn dialog."
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9327
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9328
    Warning raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9329
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9330
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9331
     nil warn:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9332
     self warn:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9333
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9334
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9335
    "
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9336
     Warning handle:[:ex |
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9337
        Transcript showCR:ex description.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9338
        ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9339
     ] do:[
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9340
        'hello' printCR.
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  9341
        self warn:'some info'.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
  9342
        'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9343
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9344
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9345
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9346
    "Modified: 20.5.1996 / 10:28:53 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9347
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9348
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9349
!Object methodsFor:'visiting'!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9350
8426
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9351
acceptVisitor:aVisitor
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9352
    "double-dispatch onto a Visitor."
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9353
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9354
    ^ self acceptVisitor:aVisitor with:nil
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9355
!
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
  9356
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9357
acceptVisitor:aVisitor with:aParameter
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9358
    "double-dispatch onto a Visitor.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9359
     Subclasses redefine this"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9360
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9361
    ^ aVisitor visitObject:self with:aParameter
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9362
!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9363
8879
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9364
elementDescriptorFor:anAspectSymbol
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9365
    "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
  9366
     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
  9367
     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
  9368
     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
  9369
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9370
     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
  9371
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9372
    |ret|
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9373
8879
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9374
    ret := 0.
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9375
    anAspectSymbol notNil ifTrue:[
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9376
        ret := self perform:anAspectSymbol ifNotUnderstood:[0].
69a4b8db130c #elementDescriptorFor: take care vor nil-aspects
Stefan Vogel <sv@exept.de>
parents: 8876
diff changeset
  9377
    ].
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9378
    ret == 0 ifTrue:[
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9379
        ^ self elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9380
    ].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9381
    ^ ret.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9382
!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9383
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9384
elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9385
    "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
  9386
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9387
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | true].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9388
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9389
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9390
      #(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
  9391
      Dictionary new elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9392
      (5 @ nil) elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9393
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9394
!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9395
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9396
elementDescriptorForInstanceVariablesMatching:aBlock
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9397
    "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
  9398
     Indexed vars are all included."
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9399
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9400
    |instVarNames theClass children
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9401
     instSize "{ Class: SmallInteger }" 
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9402
     varSize "{ Class: SmallInteger }"|
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9403
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9404
    theClass := self class.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9405
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9406
    instSize := theClass instSize.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9407
    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
  9408
    children := OrderedCollection new:(instSize + varSize).
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9409
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9410
    instVarNames := theClass allInstVarNames.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9411
    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
  9412
        var := self instVarAt:i.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9413
        (aBlock value:var) ifTrue:[
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9414
            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
  9415
        ]
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9416
    ].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9417
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9418
    varSize ~~ 0 ifTrue:[
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9419
        1 to:varSize do:[:i |
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9420
            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
  9421
        ]
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9422
    ].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9423
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9424
    ^ children.
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9425
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9426
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9427
      #(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
  9428
      Dictionary new elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9429
      (5 @ nil) elementDescriptorForInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9430
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9431
!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9432
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9433
elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9434
    "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
  9435
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9436
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | val notNil].
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9437
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9438
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9439
      #(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
  9440
      Dictionary new elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9441
      (5 @ nil) elementDescriptorForNonNilInstanceVariables
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9442
    "
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9443
! !
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  9444
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9445
!Object class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  9446
5754
333aba8041c2 checkin from browser
tm
parents: 5706
diff changeset
  9447
version
9335
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
  9448
    ^ '$Header: /cvs/stx/stx/libbasic/Object.st,v 1.558 2006-04-26 11:13:22 cg Exp $'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
  9449
! !
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  9450
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9451
Object initialize!