Object.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Tue, 22 Sep 2015 16:28:42 +0100
branchjv
changeset 18759 c1217211909c
parent 18688 43370946620c
child 18800 02724cc719b6
permissions -rw-r--r--
Changed identification strings to contain jv-branch ...to make explicit that this distribution is not the official one used by eXept and therefore that eXept is not to be blamed in case of any problem.
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
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
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
"{ Package: 'stx:libbasic' }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    13
17261
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
    14
"{ NameSpace: Smalltalk }"
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
    15
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    16
nil subclass:#Object
15034
a52015f9ee8b class: Object
Claus Gittinger <cg@exept.de>
parents: 14975
diff changeset
    17
	instanceVariableNames:''
a52015f9ee8b class: Object
Claus Gittinger <cg@exept.de>
parents: 14975
diff changeset
    18
	classVariableNames:'ErrorSignal HaltSignal MessageNotUnderstoodSignal
a52015f9ee8b class: Object
Claus Gittinger <cg@exept.de>
parents: 14975
diff changeset
    19
		UserInterruptSignal RecursionInterruptSignal
15222
eb1a3e9ca200 class: Object
Stefan Vogel <sv@exept.de>
parents: 15219
diff changeset
    20
		SubscriptOutOfBoundsSignal IndexNotFoundSignal
eb1a3e9ca200 class: Object
Stefan Vogel <sv@exept.de>
parents: 15219
diff changeset
    21
		NonIntegerIndexSignal NotFoundSignal KeyNotFoundSignal
eb1a3e9ca200 class: Object
Stefan Vogel <sv@exept.de>
parents: 15219
diff changeset
    22
		ElementOutOfBoundsSignal UserNotificationSignal InformationSignal
eb1a3e9ca200 class: Object
Stefan Vogel <sv@exept.de>
parents: 15219
diff changeset
    23
		WarningSignal PrimitiveFailureSignal DeepCopyErrorSignal
eb1a3e9ca200 class: Object
Stefan Vogel <sv@exept.de>
parents: 15219
diff changeset
    24
		AbortSignal ErrorRecursion Dependencies InfoPrinting
eb1a3e9ca200 class: Object
Stefan Vogel <sv@exept.de>
parents: 15219
diff changeset
    25
		ActivityNotificationSignal InternalErrorSignal
15034
a52015f9ee8b class: Object
Claus Gittinger <cg@exept.de>
parents: 14975
diff changeset
    26
		NonWeakDependencies SynchronizationSemaphores ObjectAttributes
16291
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
    27
		ObjectAttributesAccessLock OSSignalInterruptSignal
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
    28
		FinalizationLobby RecursiveStoreStringSignal AbortAllSignal
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
    29
		EnabledBreakPoints DebuggerHooks'
15034
a52015f9ee8b class: Object
Claus Gittinger <cg@exept.de>
parents: 14975
diff changeset
    30
	poolDictionaries:''
a52015f9ee8b class: Object
Claus Gittinger <cg@exept.de>
parents: 14975
diff changeset
    31
	category:'Kernel-Objects'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    32
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    33
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    34
!Object class methodsFor:'documentation'!
3023
674376809496 general listView support (#displayOn / widthOn / heightOn)
ca
parents: 3010
diff changeset
    35
5754
333aba8041c2 checkin from browser
tm
parents: 5706
diff changeset
    36
copyright
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    37
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    38
 COPYRIGHT (c) 1988 by Claus Gittinger
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
    39
	      All Rights Reserved
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    40
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    41
 This software is furnished under a license and may be used
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    42
 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
    43
 inclusion of the above copyright notice.   This software may not
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    44
 be provided or otherwise made available to, or used by, any
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    45
 other person.  No title to or ownership of the software is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    46
 hereby transferred.
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
!
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
dependencies
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    51
"
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
    52
   ST/X dependencies are slightly modified from ST-80's
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    53
   (we think they are better ;-).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    54
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    55
   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
    56
   cannot be garbage collected because some dependency is present,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    57
   having the object as a dependent of some other object.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    58
   In ST-80, this association remains alive (because a Dictionary
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    59
   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
    60
   to dependent or the dependee.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    61
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    62
   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
    63
   prevent memory leaks.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    64
   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
    65
   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
    66
   need to care about dependencies.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
    67
   From a philosophical point of view, why should some object depend on
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    68
   something that the programmer considers a dead object ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    69
   (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
    70
    that behavior)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    71
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    72
   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
    73
   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
    74
   so these dependents go away, once the model is reclaimed.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    75
   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
    76
   needed, with general objects it is mandatory.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    77
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    78
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    79
   In ST/X, dependencies are implemented using a WeakDictionary; this means,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    80
   that once the dependee dies, the dependency association is removed automatically,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    81
   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
    82
   references exist to the dependent.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    83
   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
    84
   (in case your application heavily depends on the ST-80 mechanism), complementary
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
    85
   protocol to add nonWeak dependencies is provided
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    86
   (see #addNonWeakDependent / #removeNonWeakDependent).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    87
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    88
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    89
   Caveat:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    90
      since interests are implemented using InterestConverter (which are simply
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    91
      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
    92
      automatically).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    93
      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
    94
      and those would be reclaimed if stored in a weakDictionary.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    95
      This means, that those interests MUST be removed with #retractInterest
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
    96
      (which is bug-compatible to ST-80).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
    97
      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
    98
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
   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
   101
"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   102
!
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
documentation
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   105
"
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   106
   Object is the superclass of most other classes.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   107
   (except for nil-subclasses, which inherit nothing,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   108
    to catch any message into their #doesNotUnderstand: method)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   109
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   110
   Protocol which is common to every object is defined here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   111
   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
   112
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   113
   Object has no instance variables (and may not get any added). One reason is, that
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   114
   UndefinedObject and SmallInteger are also inheriting from Object - these two cannot
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   115
   have instance variables (due to their implementation).
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   116
   The other reason is that the runtime system (VM) knows about the layout of some built-in
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   117
   classes (think of Class, Method, Block and also Integer or Float).
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   118
   If you were allowed to add instance variables to Object, the VM had to be recompiled
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   119
   (and also rewritten in some places).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   120
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   121
   [Class variables:]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   122
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   123
	ErrorSignal     <Signal>        Signal raised for error/error: messages
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   124
					also, parent of all other signals.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   125
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   126
	HaltSignal      <Signal>        Signal raised for halt/halt: messages
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   127
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   128
	MessageNotUnderstoodSignal      Signals raised for various error conditions
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   129
	UserInterruptSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   130
	RecursionInterruptSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   131
	ExceptionInterruptSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   132
	SubscriptOutOfBoundsSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   133
	NonIntegerIndexSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   134
	NotFoundSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   135
	KeyNotFoundSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   136
	ElementOutOfBoundsSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   137
	InformationSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   138
	WarningSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   139
	DeepCopyErrorSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   140
	InternalErrorSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   141
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   142
	AbortSignal      <Signal>       Signal raised by debugger, to abort a computation
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   143
					BUT, the debugger will only raise it if it is handled.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   144
					By handling the abortSignal, you can control where the
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   145
					debuggers abort-function resumes execution in case of
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   146
					an error.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   147
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   148
	ErrorRecursion   <Boolean>      controls behavior when recursive errors occur (i.e.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   149
					an error while handling an error).
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   150
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   151
	Dependencies     <WeakDependencyDictionary>
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   152
					keeps track of object dependencies.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   153
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   154
	InfoPrinting     <Boolean>      controls weather informational messages
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   155
					are printed.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   156
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   157
	ActivityNotificationSignal <QuerySignal>
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   158
					 raised on #activityNotification:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   159
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   160
	NonWeakDependencies <Dictionary> keeps track of object dependencies.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   161
					 Dependents stay alive.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   162
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   163
	SynchronizationSemaphores <WeakIdentityDictionary>
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   164
					 Semaphores for per-object-monitor.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   165
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   166
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   167
    [author:]
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   168
	Claus Gittinger
5755
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
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   172
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   173
!Object class methodsFor:'initialization'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   174
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   175
initSignals
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   176
    "called only once - initialize signals"
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   177
15193
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   178
    "/ notice: the class variables here are a leftover from times
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   179
    "/ when errors where signal-instance, not class based.
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   180
    "/ then, signal instances where created here and kept as class vars,
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   181
    "/ to be fetched from the class var or via signal-getter methods.
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   182
    "/ Nowadays, we use class based exceptions, where the exception class
15193
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   183
    "/ is directly referenced.
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   184
    "/ the classvars here are kept for backward compatibility, but they now
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   185
    "/ simply alias the corresponding exception class.
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   186
    "/ Old code should be rewritten to access the error class.
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   187
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   188
    ErrorSignal := Error.
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   189
    HaltSignal := HaltInterrupt.
5977
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   190
    MessageNotUnderstoodSignal := MessageNotUnderstood.
6000
d6fbafc5879e more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5995
diff changeset
   191
    PrimitiveFailureSignal := PrimitiveFailure.
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   192
    InternalErrorSignal := VMInternalError.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   193
    UserInterruptSignal := UserInterrupt.
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   194
    RecursionInterruptSignal := RecursionError.
5977
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   195
    NotFoundSignal := NotFoundError.
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   196
    IndexNotFoundSignal := IndexNotFoundError.
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   197
    SubscriptOutOfBoundsSignal := SubscriptOutOfBoundsError.
1aa80a42ed64 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5971
diff changeset
   198
    NonIntegerIndexSignal := NonIntegerIndexError.
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   199
    KeyNotFoundSignal := KeyNotFoundError.
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   200
    ElementOutOfBoundsSignal := ElementBoundsError.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
   201
    UserNotificationSignal := UserNotification.
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
   202
    WarningSignal := Warning.
7035
1d049fb7ae5a Make UserInformation a class based exception
Stefan Vogel <sv@exept.de>
parents: 7033
diff changeset
   203
    InformationSignal := UserInformation.
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   204
    ActivityNotificationSignal := ActivityNotification.
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   205
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   206
    DeepCopyErrorSignal := DeepCopyError.
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   207
6203
d39d75849383 class based exceptions - abortSignal
Claus Gittinger <cg@exept.de>
parents: 6199
diff changeset
   208
    AbortSignal := AbortOperationRequest.
6877
ab4e7d42f9f8 AbortAllOperation - now class based
Claus Gittinger <cg@exept.de>
parents: 6874
diff changeset
   209
    AbortAllSignal := AbortAllOperationRequest.
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   210
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   211
    OSSignalInterruptSignal := OSSignalInterrupt.
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   212
    RecursiveStoreStringSignal := RecursiveStoreError.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   213
5980
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   214
    "
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   215
     Object initSignals
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   216
    "
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   217
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   218
    "Modified: / 22.1.1998 / 21:23:40 / av"
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   219
    "Modified: / 4.8.1999 / 08:54:06 / stefan"
6203
d39d75849383 class based exceptions - abortSignal
Claus Gittinger <cg@exept.de>
parents: 6199
diff changeset
   220
    "Modified: / 16.11.2001 / 16:30:08 / cg"
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   221
!
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   222
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   223
initialize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   224
    "called only once - initialize signals"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   225
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   226
    ErrorSignal isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
   227
	self initSignals.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
   228
	ErrorRecursion := true.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   229
    ].
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
    ObjectAttributes isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
   232
	ObjectAttributes := WeakIdentityDictionary new.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
   233
	ObjectAttributesAccessLock := RecursionLock new.
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
    Dependencies isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
   236
	Dependencies := WeakDependencyDictionary new.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   237
    ].
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   238
    NonWeakDependencies isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
   239
	NonWeakDependencies := IdentityDictionary new.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   240
    ].
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   241
    SynchronizationSemaphores isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
   242
	SynchronizationSemaphores := WeakIdentityDictionary new.
5971
686ef746dacc *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5926
diff changeset
   243
    ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   244
    FinalizationLobby isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
   245
	FinalizationLobby := Registry new.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   246
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   247
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   248
    "/ initialize InfoPrinting to the VM's infoPrint setting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   249
    "/ (which can be turned off via a command line argument)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   250
    InfoPrinting := ObjectMemory infoPrinting.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   251
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   252
    "Object initialize"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   253
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   254
    "Modified: / 22.1.1998 / 21:23:40 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   255
    "Modified: / 3.2.1998 / 18:55:09 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   256
    "Modified: / 4.8.1999 / 08:54:06 / stefan"
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
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
   259
7303
98111fb6a285 category
Claus Gittinger <cg@exept.de>
parents: 7285
diff changeset
   260
!Object class methodsFor:'Compatibility-ST80'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   261
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   262
rootError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   263
    "return the signal used for error/error: - handling.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   264
     Same as errorSignal for ST80 compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   265
7094
617eeaf2f8ba Convert Object>>errorSignal -> Error
Stefan Vogel <sv@exept.de>
parents: 7081
diff changeset
   266
    ^ Error
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   267
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   268
    "Created: / 15.1.1998 / 23:47:05 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   269
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   270
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   271
!Object class methodsFor:'Signal constants'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   272
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   273
abortAllSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   274
    "return the signal used to abort user actions (much like AbortSignal).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   275
     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
   276
     the loop (such as when confirming multiple class deletions etc.)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   277
15903
7de2ea21e054 AbortSignal -> AbortOperationRequest
Stefan Vogel <sv@exept.de>
parents: 15891
diff changeset
   278
    ^ AbortAllOperationRequest
5755
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
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   281
abortSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   282
    "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
   283
     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
   284
     currently active doIt/printIt or inspectIt. (also some others use
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   285
     this for a save abort)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   286
8521
60f0e479ffc1 use class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8502
diff changeset
   287
    ^ AbortOperationRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   288
!
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
activityNotificationSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   291
    "return the signal used for activity notifications.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   292
     A handler for this signal gets all #activityNotification: sends"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   293
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   294
    ^ ActivityNotification
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   295
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   296
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
   297
ambiguousMessageSignal
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
   298
    "return the signal used for ambiguousMessage: - error handling"
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
   299
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
   300
    ^ AmbiguousMessage
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
   301
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
   302
    "Created: / 21-07-2010 / 15:39:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
   303
!
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
   304
11132
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
   305
conversionErrorSignal
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
   306
    "return the signal used for conversion error handling"
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
   307
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
   308
    ^ ConversionError
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
   309
!
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
   310
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   311
deepCopyErrorSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   312
    "return the signal raised when a deepcopy is asked for
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   313
     an object which cannot do this (for example, BlockClosures
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   314
     or Contexts)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   315
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   316
    ^ DeepCopyError
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   317
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   318
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   319
elementOutOfBoundsSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   320
    "return the signal used for element error reporting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   321
     (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
   322
      be put into a bytearray)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   323
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   324
    ^ ElementBoundsError
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   325
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   326
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   327
errorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   328
    "return the signal used for error/error: - handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   329
7094
617eeaf2f8ba Convert Object>>errorSignal -> Error
Stefan Vogel <sv@exept.de>
parents: 7081
diff changeset
   330
    ^ Error
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   333
haltSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   334
    "return the signal used for halt/halt: - handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   335
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   336
    ^ HaltSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   337
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   338
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   339
indexNotFoundSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   340
    "return the signal used for bad index error reporting.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   341
     This is also the parentSignal of the nonIntegerIndex- and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   342
     subscriptOutOfBoundsSignal"
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
    ^ IndexNotFoundSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   345
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   346
    "Created: / 8.11.1997 / 19:15:48 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   347
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   348
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   349
informationSignal
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   350
    "return the signal used for informations.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   351
     A handler for this signal gets all #information: sends"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   352
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   353
    ^ InformationSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   354
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   355
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   356
internalErrorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   357
    "return the signal used to report internal (VM-) errors."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   358
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   359
    ^ VMInternalError
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   360
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   361
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   362
keyNotFoundSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   363
    "return the signal used for no such key error reporting"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   364
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   365
    ^ KeyNotFoundError
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   368
messageNotUnderstoodSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   369
    "return the signal used for doesNotUnderstand: - error handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   370
15193
e84b5268e918 class: Object
Claus Gittinger <cg@exept.de>
parents: 15128
diff changeset
   371
    ^ MessageNotUnderstood
5755
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
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   374
nonIntegerIndexSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   375
    "return the signal used for bad subscript error reporting"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   376
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   377
    ^ NonIntegerIndexSignal
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
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   380
notFoundSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   381
    "return the signal used for no element found error reporting"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   382
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   383
    ^ NotFoundSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   384
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   385
7644
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   386
notifySignal
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   387
    "return the parent of all notification signals."
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   388
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   389
    ^ Notification
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   390
!
211762a9a39f added notifySignal for VW compatibility
Claus Gittinger <cg@exept.de>
parents: 7621
diff changeset
   391
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   392
osSignalInterruptSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   393
    "return the signal used for OS-signal error reporting;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   394
     This is only raised if handled - otherwise, a debugger is entered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   395
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   396
    ^ OSSignalInterrupt
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   397
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   398
    "Modified: / 12.6.1998 / 16:27:26 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   399
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   400
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   401
primitiveFailureSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   402
    "return the signal used for primitiveFailed - error handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   403
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   404
    ^ PrimitiveFailure
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   407
privateMethodSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   408
    "return the signal used for privateMethod - error handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   409
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   410
    ^ MessageNotUnderstoodSignal
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
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   413
recursionInterruptSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   414
    "return the signal used for recursion overflow error handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   415
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   416
    ^ RecursionInterruptSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   417
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   418
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   419
recursiveStoreStringSignal
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   420
    "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
   421
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   422
    ^ RecursiveStoreError
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   423
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   424
    "
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
   425
     RecursiveStoreError handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   426
	self halt
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   427
     ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   428
	|a|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   429
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   430
	a := Array new:1.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   431
	a at:1 put:a.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   432
	a storeOn:Transcript
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   433
     ]
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   436
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   437
     |a|
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
     a := Array new:1.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   440
     a at:1 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   441
     a storeOn:Transcript
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   442
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   443
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   444
5980
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   445
subclassResponsibilitySignal
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   446
    "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
   447
     (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
   448
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   449
    ^ SubclassResponsibilityError
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   450
!
5fd29de6d596 more class based exceptions
Claus Gittinger <cg@exept.de>
parents: 5977
diff changeset
   451
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   452
subscriptOutOfBoundsSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   453
    "return the signal used for subscript error reporting.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   454
     (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
   455
      index less than 1 or greater than the array size)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   456
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   457
    ^ SubscriptOutOfBoundsSignal
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   460
userInterruptSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   461
    "return the signal used for ^C interrupts handling"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   462
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   463
    ^ UserInterruptSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   464
!
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
    "the parent signal used with information and warnings.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   468
     Handling this allows handling of both information- and warning notifications."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   469
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   470
    ^ UserNotificationSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   471
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   472
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
   473
warningSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   474
    "return the signal used for warnings.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   475
     A handler for this signal gets all #warn: sends"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   476
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   477
    ^ WarningSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   478
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   479
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   480
!Object class methodsFor:'info messages'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   481
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   482
infoPrinting
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   483
    "return the flag which controls information messages."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   484
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   485
    ^ InfoPrinting
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   488
infoPrinting:aBoolean
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   489
    "{ Pragma: +optSpace }"
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
    "turn on/off printing of information messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   492
     If the argument, aBoolean is false, infoPrint will not output
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   493
     messages. The default is true."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   494
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   495
    InfoPrinting := aBoolean
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   496
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   497
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
   498
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   499
!Object class methodsFor:'queries'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   500
8892
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8879
diff changeset
   501
isAbstract
11221
1e88faaa1249 comment
Claus Gittinger <cg@exept.de>
parents: 11161
diff changeset
   502
    "Return if this class is an abstract class.
1e88faaa1249 comment
Claus Gittinger <cg@exept.de>
parents: 11161
diff changeset
   503
     True is returned for Object here; false for subclasses.
1e88faaa1249 comment
Claus Gittinger <cg@exept.de>
parents: 11161
diff changeset
   504
     Abstract subclasses must redefine again."
1e88faaa1249 comment
Claus Gittinger <cg@exept.de>
parents: 11161
diff changeset
   505
8892
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8879
diff changeset
   506
    ^ self == Object
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8879
diff changeset
   507
!
5d05a7f150a5 +isAbstract
Claus Gittinger <cg@exept.de>
parents: 8879
diff changeset
   508
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   509
isBuiltInClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   510
    "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
   511
     i.e. you cannot add/remove instance variables without recompiling
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   512
     the VM.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   513
     Here, true is returned for myself, false for subclasses."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   514
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   515
    ^ self == Object
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   516
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   517
    "Modified: 23.4.1996 / 16:00:07 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   518
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   519
14296
fe82bc5091f9 added: #isUUID
Stefan Vogel <sv@exept.de>
parents: 14292
diff changeset
   520
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
   521
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
   522
8441
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   523
!Object methodsFor:'Compatibility-Dolphin'!
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   524
11161
3888d6f4e6f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11142
diff changeset
   525
stbFixup: anSTBInFiler at: newObjectIndex
3888d6f4e6f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11142
diff changeset
   526
    "Answer the true object that must be used to represent the receiver when read from anSTBInFiler.
3888d6f4e6f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11142
diff changeset
   527
     Typically this is overridden by subclasses of STBProxy to answer the proxied object. Other classes
3888d6f4e6f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11142
diff changeset
   528
     may also override this method to effectively 'one way become' the receiver to some other object"
3888d6f4e6f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11142
diff changeset
   529
3888d6f4e6f9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11142
diff changeset
   530
    ^ self
8441
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   531
! !
728c887f2532 Dolphin compatibility: #trigger...
Stefan Vogel <sv@exept.de>
parents: 8426
diff changeset
   532
14682
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   533
!Object methodsFor:'Compatibility-GNU'!
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   534
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   535
display
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   536
    "print the receiver on the standard output stream (which is not the Transcript).
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   537
     Added for GNU-ST compatibility"
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   538
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   539
    self print
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   540
!
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   541
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   542
displayNl
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   543
    "print the receiver followed by a cr on the standard output stream (which is not the Transcript).
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   544
     Added for GNU-ST compatibility"
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   545
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   546
    self printCR
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   547
! !
6451898ed2a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 14676
diff changeset
   548
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7216
diff changeset
   549
!Object methodsFor:'Compatibility-ST80'!
5755
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
isMetaclass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   552
    ^ self isMeta
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   553
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   554
7261
f35fc9cee675 method category rename
Claus Gittinger <cg@exept.de>
parents: 7216
diff changeset
   555
!Object methodsFor:'Compatibility-Squeak'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   556
9071
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   557
becomeForward:anotherObject
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
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   561
becomeForward:anotherObject copyHash:copyHash
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   562
    copyHash ifTrue:[ self error:'unsupported operation' ].
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   563
    self becomeSameAs:anotherObject
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   564
!
e7d44f6f017a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9005
diff changeset
   565
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   566
clone
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   567
    ^ self shallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   568
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   569
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   570
copyTwoLevel
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   571
    "one more level than a shallowCopy"
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   572
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   573
    ^ self copyToLevel:2
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   574
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   575
    "
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   576
     |original copy elL1 elL2 elL3 copyOfElL1|
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   577
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   578
     original := Array new:3.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   579
     original at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   580
     original at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   581
     original at:3 put:(elL1 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   582
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   583
     elL1 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   584
     elL1 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   585
     elL1 at:3 put:(elL2 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   586
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   587
     elL2 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   588
     elL2 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   589
     elL2 at:3 put:(elL3 := Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   590
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   591
     elL3 at:1 put:1234.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   592
     elL3 at:2 put:'hello'.
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   593
     elL3 at:3 put:(Array new:3).
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   594
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   595
     copy := original copyTwoLevel.
14534
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
   596
     self assert:((original at:2) ~~ (copy at:2)).
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
   597
     self assert:((original at:3) ~~ (copy at:3)).
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   598
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   599
     copyOfElL1 := copy at:3.
14534
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
   600
     self assert:((elL1 at:2) == (copyOfElL1 at:2)).
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
   601
     self assert:((elL1 at:3) == (copyOfElL1 at:3)).
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   602
    "
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   603
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
   604
7320
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   605
explore
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   606
    (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
   607
    ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   608
	self inspect
7320
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   609
    ]
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   610
!
0d5b4de4045a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7303
diff changeset
   611
18259
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
   612
flag:aString
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
   613
    "Send this message, with a relevant symbol as argument, to flag a message for subsequent retrieval.  For example, you might put the following line in a number of messages:
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
   614
     self flag: #returnHereUrgently
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
   615
     Then, to retrieve all such messages, browse all senders of #returnHereUrgently."
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
   616
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
   617
    "Created: / 21-04-2015 / 15:50:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
   618
!
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
   619
12285
54773840f621 added: #inform: - squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 12158
diff changeset
   620
inform: aString
54773840f621 added: #inform: - squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 12158
diff changeset
   621
    "Display a message for the user to read and then dismiss."
54773840f621 added: #inform: - squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 12158
diff changeset
   622
54773840f621 added: #inform: - squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 12158
diff changeset
   623
    self information:aString
54773840f621 added: #inform: - squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 12158
diff changeset
   624
!
54773840f621 added: #inform: - squeak compatibility
Claus Gittinger <cg@exept.de>
parents: 12158
diff changeset
   625
16021
301a3939838f class: Object
Claus Gittinger <cg@exept.de>
parents: 16012
diff changeset
   626
isCompiledMethod
301a3939838f class: Object
Claus Gittinger <cg@exept.de>
parents: 16012
diff changeset
   627
    "same as isMethod - for squeak compatibility"
301a3939838f class: Object
Claus Gittinger <cg@exept.de>
parents: 16012
diff changeset
   628
301a3939838f class: Object
Claus Gittinger <cg@exept.de>
parents: 16012
diff changeset
   629
    ^ false
301a3939838f class: Object
Claus Gittinger <cg@exept.de>
parents: 16012
diff changeset
   630
!
301a3939838f class: Object
Claus Gittinger <cg@exept.de>
parents: 16012
diff changeset
   631
9335
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   632
isInMemory
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   633
    "All normal objects are."
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   634
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   635
    ^ true
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   636
!
2dcbf8f91693 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9314
diff changeset
   637
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   638
stringForReadout
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   639
	^ self stringRepresentation
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   640
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   641
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   642
stringRepresentation
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   643
	"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"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   644
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   645
	^ self printString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   646
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   647
9146
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   648
valueWithPossibleArguments:argArray
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   649
     ^ self
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   650
!
56176a7bf685 +valueWithPossibleArguments:
Claus Gittinger <cg@exept.de>
parents: 9105
diff changeset
   651
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   652
veryDeepCopy
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
   653
     ^ self deepCopyUsing:(IdentityDictionary new)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   654
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   655
7567
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   656
!Object methodsFor:'Compatibility-VW'!
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   657
8637
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   658
isCharacters
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   659
    "added for visual works compatibility"
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   660
    ^ false
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   661
!
e7e695f53819 *** empty log message ***
penk
parents: 8632
diff changeset
   662
18151
abf5900dc119 class: Object
Claus Gittinger <cg@exept.de>
parents: 18149
diff changeset
   663
isSignalledException
abf5900dc119 class: Object
Claus Gittinger <cg@exept.de>
parents: 18149
diff changeset
   664
    "VW compatibility"
abf5900dc119 class: Object
Claus Gittinger <cg@exept.de>
parents: 18149
diff changeset
   665
abf5900dc119 class: Object
Claus Gittinger <cg@exept.de>
parents: 18149
diff changeset
   666
    ^ self isException
abf5900dc119 class: Object
Claus Gittinger <cg@exept.de>
parents: 18149
diff changeset
   667
!
abf5900dc119 class: Object
Claus Gittinger <cg@exept.de>
parents: 18149
diff changeset
   668
7567
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   669
keyNotFoundError:aKey
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   670
    "VW compatibility"
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   671
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   672
    self errorKeyNotFound:aKey.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   673
!
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   674
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   675
oneWayBecome:anotherObject
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   676
    ^ self becomeSameAs:anotherObject
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 oneWayBecome: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
     |arr o1 o2|
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   689
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   690
     arr := Array new:2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   691
     arr at:1 put:(o1 := Object new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   692
     arr at:2 put:(o2 := Point new).
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   693
     o1 becomeSameAs:o2.
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   694
     (arr at:1) ~~ o2 ifTrue:[self halt].
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   695
    "
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   696
! !
1c1a49b3ebf0 compatibility
Claus Gittinger <cg@exept.de>
parents: 7566
diff changeset
   697
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
   698
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   699
!Object methodsFor:'accessing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   700
13320
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   701
_at:index
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   702
    "experimental:
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   703
     this is a synthetic selector, generated by the compiler,
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   704
     if a construct of the form expr[idx...] is parsed.
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   705
     I.e.
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   706
	v[n]
13320
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   707
     generates
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   708
	v _at: n
13320
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   709
    "
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   710
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   711
    ^ self at:index
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   712
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   713
    "Created: / 21-03-2011 / 14:07:57 / cg"
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   714
!
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   715
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   716
_at:index put:value
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   717
    "experimental:
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   718
     this is a synthetic selector, generated by the compiler,
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   719
     if a construct of the form expr[idx...] is parsed.
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   720
     I.e.
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   721
	v[n]
13320
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   722
     generates
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   723
	v _at: n
13320
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   724
    "
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   725
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   726
    ^ self at:index put:value
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   727
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   728
    "Created: / 21-03-2011 / 14:10:12 / cg"
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   729
!
Claus Gittinger <cg@exept.de>
parents: 13261
diff changeset
   730
14705
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   731
addSlot: slotName
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   732
    "dynamically add a new slot to the receiver.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   733
     The receiver must be a real object, not nil or a smallInteger"
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   734
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   735
    |classGetter myClass anonCls newObj|
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   736
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   737
    myClass := self class.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   738
    classGetter := ('%__get_',slotName,'__') asSymbol.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   739
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   740
    anonCls := self perform:classGetter ifNotUnderstood:nil.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   741
    anonCls isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   742
	anonCls := myClass
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   743
		subclass:(myClass name,'+',slotName) asSymbol
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   744
		instanceVariableNames:slotName
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   745
		classVariableNames:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   746
		poolDictionaries:'' category:nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   747
		inEnvironment:nil.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   748
	anonCls compile:('%1 ^  %1' bindWith:slotName).
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   749
	anonCls compile:('%1:v %1 := v' bindWith:slotName).
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   750
	Class withoutUpdatingChangesDo:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   751
	    |m|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   752
	    m := Compiler compile:('__get_',slotName,' ^ #fooBar' bindWith:slotName) forClass:myClass install:false.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   753
	    m literalAt:(m literals indexOf:#fooBar) put:anonCls.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   754
	    myClass addSelector:classGetter withMethod:m.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   755
	].
14705
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   756
    ].
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   757
    newObj := anonCls cloneFrom:self.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   758
    self become:newObj.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   759
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   760
    "
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   761
     |p1 p2 p3|
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   762
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   763
     p1 := Point x:10 y:20.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   764
     p2 := Point x:100 y:200.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   765
     Transcript show:'p1 is '; showCR:p1.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   766
     Transcript show:'p2 is '; showCR:p2.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   767
     p1 addSlot:'z'.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   768
     p1 z:30.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   769
     Transcript show:'p1 is '; showCR:p1.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   770
     Transcript show:'p2 is '; showCR:p2.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   771
     ObjectMemory dumpObject:p1.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   772
     ObjectMemory dumpObject:p2.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   773
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   774
     p1 addSlot:'t'.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   775
     p1 t:30.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   776
     Transcript show:'p1 is '; showCR:p1.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   777
     ObjectMemory dumpObject:p1.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   778
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   779
     p3 := Point x:110 y:120.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   780
     p3 addSlot:'z'.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   781
     p3 addSlot:'t'.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   782
     p1 inspect.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   783
     p2 inspect.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   784
     p3 inspect.
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   785
    "
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   786
!
35456d16bcea class: Object
Claus Gittinger <cg@exept.de>
parents: 14682
diff changeset
   787
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   788
at:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   789
    "return the indexed instance variable with index, anInteger;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   790
     this method can be redefined in subclasses."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   791
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   792
    ^ self basicAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   793
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   794
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   795
at:index put:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   796
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   797
     this method can be redefined in subclasses. Returns anObject (sigh)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   798
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   799
    ^ self basicAt:index put:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   800
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   801
    "Modified: 19.4.1996 / 11:13:29 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   802
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   803
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   804
basicAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   805
    "return the indexed instance variable with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   806
     Trigger an error if the receiver has no indexed instance variables.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   807
     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
   808
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   809
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
   810
#ifdef __SCHTEAM__
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   811
    {
18361
6f4ec9a1b98a comments only
Claus Gittinger <cg@exept.de>
parents: 18352
diff changeset
   812
	int idx1Based = index.intValue();   // st index is 1 based
18404
ae9230dde5ca comments
Claus Gittinger <cg@exept.de>
parents: 18371
diff changeset
   813
	return context._RETURN( self.basicAt( idx1Based ));
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   814
    }
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   815
    /* NOTREACHED */
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   816
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   817
    REGISTER int nbytes, indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   818
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   819
    REGISTER char *pFirst;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   820
    REGISTER int n;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   821
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   822
    /*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   823
     * notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   824
     * this can be done since basicAt: is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   825
     * and SmallInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   826
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
   827
    if (__isSmallInteger(index)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   828
	myClass = __qClass(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   829
	indx = __intVal(index) - 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   830
	n /* nInstVars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   831
	n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* nInstVars */);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   832
	nbytes = __qSize(self) - n /* nInstBytes */;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   833
	pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   834
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   835
	switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   836
	    case __MASKSMALLINT(POINTERARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   837
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   838
		 * pointers
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   839
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   840
		if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   841
		    OBJ *op;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   842
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   843
		    op = (OBJ *)pFirst + indx;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   844
		    RETURN ( *op );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   845
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   846
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   847
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   848
	    case __MASKSMALLINT(WKPOINTERARRAY):
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   849
		if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   850
		    OBJ *op;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   851
		    OBJ el;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   852
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   853
		    op = (OBJ *)pFirst + indx;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   854
		    el = *op;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   855
		    el = __WEAK_READ__(self, el);
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   856
		    RETURN ( el );
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   857
		}
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   858
		break;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
   859
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   860
	    case __MASKSMALLINT(BYTEARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   861
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   862
		 * (unsigned) bytes
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   863
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   864
		if ((unsigned)indx < nbytes) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   865
		    unsigned char *cp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   866
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   867
		    cp = (unsigned char *)pFirst + indx;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   868
		    RETURN ( __mkSmallInteger( (*cp & 0xFF)) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   869
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   870
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   871
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   872
	    case __MASKSMALLINT(FLOATARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   873
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   874
		 * native floats
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   875
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   876
		if ((unsigned)indx < (nbytes / sizeof(float))) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   877
		    float *fp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   878
		    float f;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   879
		    OBJ v;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   880
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   881
		    fp = (float *)pFirst + indx;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   882
		    f = *fp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   883
		    if (f == 0.0) {
17456
2365cd3471c9 __float constants renamed
Claus Gittinger <cg@exept.de>
parents: 17437
diff changeset
   884
			v = STX__float0;
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   885
		    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   886
			__qMKSFLOAT(v, f);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   887
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   888
		    RETURN (v);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   889
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   890
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   891
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   892
	    case __MASKSMALLINT(DOUBLEARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   893
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   894
		 * native doubles
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   895
		 */
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   896
# ifdef __NEED_DOUBLE_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   897
		if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   898
		    int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   899
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   900
		    pFirst += delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   901
		    nbytes -= delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   902
		}
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   903
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   904
		if ((unsigned)indx < (nbytes / sizeof(double))) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   905
		    double *dp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   906
		    double d;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   907
		    OBJ v;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   908
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   909
		    dp = (double *)pFirst + indx;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   910
		    d = *dp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   911
		    if (d == 0.0) {
17456
2365cd3471c9 __float constants renamed
Claus Gittinger <cg@exept.de>
parents: 17437
diff changeset
   912
			v = STX__float0;
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   913
		    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   914
			__qMKFLOAT(v, d);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   915
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   916
		    RETURN (v);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   917
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   918
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   919
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   920
	    case __MASKSMALLINT(WORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   921
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   922
		 * unsigned 16bit ints
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   923
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   924
		/* Notice: the hard coded shifts are by purpose;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   925
		 * it makes us independent of the short-size of the machine
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   926
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   927
		if ((unsigned)indx < (nbytes>>1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   928
		    unsigned short *sp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   929
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   930
		    sp = (unsigned short *)(pFirst + (indx<<1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   931
		    RETURN ( __mkSmallInteger( (*sp & 0xFFFF)) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   932
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   933
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   934
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   935
	    case __MASKSMALLINT(SWORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   936
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   937
		 * signed 16bit ints
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   938
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   939
		/* Notice: the hard coded shifts are by purpose;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   940
		 * it makes us independent of the short-size of the machine
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   941
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   942
		if ((unsigned)indx < (nbytes>>1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   943
		    short *ssp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   944
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   945
		    ssp = (short *)(pFirst + (indx<<1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   946
		    RETURN ( __mkSmallInteger( (*ssp) ));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   947
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   948
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   949
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   950
	    case __MASKSMALLINT(LONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   951
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   952
		 * unsigned 32bit ints
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   953
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   954
		/* Notice: the hard coded shifts are by purpose;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   955
		 * it makes us independent of the int-size of the machine
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   956
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   957
		if ((unsigned)indx < (nbytes>>2)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   958
		    unsigned int32 ul;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   959
		    unsigned int32 *lp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   960
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   961
		    lp = (unsigned int32 *)(pFirst + (indx<<2));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   962
		    ul = *lp;
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   963
# if __POINTER_SIZE__ == 8
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   964
		    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   965
			unsigned INT ull = (unsigned INT)ul;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   966
			RETURN ( __mkSmallInteger(ull) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   967
		    }
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   968
# else
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   969
		    if (ul <= _MAX_INT) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   970
			RETURN ( __mkSmallInteger(ul) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   971
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   972
		    RETURN ( __MKULARGEINT(ul) );
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   973
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   974
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   975
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   976
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   977
	    case __MASKSMALLINT(SLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   978
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   979
		 * signed 32bit ints
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   980
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   981
		/* Notice: the hard coded shifts are by purpose;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   982
		 * it makes us independent of the int-size of the machine
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   983
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   984
		if ((unsigned)indx < (nbytes>>2)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   985
		    int32 *slp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   986
		    int32 l;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   987
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   988
		    slp = (int32 *)(pFirst + (indx<<2));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   989
		    l = *slp;
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   990
# if __POINTER_SIZE__ == 8
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   991
		    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   992
			INT ll = (INT)l;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   993
			RETURN ( __mkSmallInteger(ll) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   994
		    }
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
   995
# else
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   996
		    if (__ISVALIDINTEGER(l)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   997
			RETURN ( __mkSmallInteger(l) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   998
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
   999
		    RETURN ( __MKLARGEINT(l) );
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1000
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1001
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1002
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1003
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1004
	    case __MASKSMALLINT(SLONGLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1005
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1006
		 * signed 64bit longlongs
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1007
		 */
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1008
# ifdef __NEED_LONGLONG_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1009
		if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1010
		    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1011
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1012
		    pFirst += delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1013
		    nbytes -= delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1014
		}
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1015
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1016
		/* Notice: the hard coded shifts are by purpose;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1017
		 * it makes us independent of the long/longlong-size of the machine
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1018
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1019
		if ((unsigned)indx < (nbytes>>3)) {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1020
# if __POINTER_SIZE__ == 8
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1021
		    INT *slp, ll;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1022
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1023
		    slp = (INT *)(pFirst + (indx<<3));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1024
		    ll = *slp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1025
		    if (__ISVALIDINTEGER(ll)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1026
			RETURN ( __mkSmallInteger(ll) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1027
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1028
		    RETURN ( __MKLARGEINT(ll) );
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1029
# else
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1030
		    __int64__ *llp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1031
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1032
		    llp = (__int64__ *)(pFirst + (indx<<3));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1033
		    RETURN (__MKINT64(llp));
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1034
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1035
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1036
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1037
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1038
	    case __MASKSMALLINT(LONGLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1039
		/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1040
		 * unsigned 64bit longlongs
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1041
		 */
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1042
# ifdef __NEED_LONGLONG_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1043
		if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1044
		    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1045
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1046
		    pFirst += delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1047
		    nbytes -= delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1048
		}
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1049
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1050
		/* Notice: the hard coded shifts are by purpose;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1051
		 * it makes us independent of the long/longlong-size of the machine
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1052
		 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1053
		if ((unsigned)indx < (nbytes>>3)) {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1054
# if __POINTER_SIZE__ == 8
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1055
		    unsigned INT *ulp, ul;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1056
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1057
		    ulp = (unsigned INT *)(pFirst + (indx<<3));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1058
		    ul = *ulp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1059
		    if (ul <= _MAX_INT) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1060
			RETURN ( __mkSmallInteger(ul) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1061
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1062
		    RETURN ( __MKULARGEINT(ul) );
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1063
# else
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1064
		    __uint64__ *llp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1065
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1066
		    llp = (__uint64__ *)(pFirst + (indx<<3));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1067
		    RETURN (__MKUINT64(llp));
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1068
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1069
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1070
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1071
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1072
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  1073
#endif /* ! __SCHTEAM__ */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1074
%}.
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1075
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1076
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1077
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1078
basicAt:index put:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1079
    "store the 2nd arg, anObject as indexed instvar with index, anInteger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1080
     Returns anObject (sigh).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1081
     Trigger an error if the receiver has no indexed instance variables.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1082
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1083
     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
  1084
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1085
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  1086
#ifdef __SCHTEAM__
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1087
    {
18361
6f4ec9a1b98a comments only
Claus Gittinger <cg@exept.de>
parents: 18352
diff changeset
  1088
	int idx1Based = index.intValue();   // st index is 1 based
6f4ec9a1b98a comments only
Claus Gittinger <cg@exept.de>
parents: 18352
diff changeset
  1089
6f4ec9a1b98a comments only
Claus Gittinger <cg@exept.de>
parents: 18352
diff changeset
  1090
	self.basicAt_put(idx1Based, anObject );
18404
ae9230dde5ca comments
Claus Gittinger <cg@exept.de>
parents: 18371
diff changeset
  1091
	return context._RETURN( anObject );
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1092
    }
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1093
    /* NOTREACHED */
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1094
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1095
    register int nbytes, indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1096
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1097
    register char *pFirst;
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1098
    /* int nInstBytes, ninstvars, flags; */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1099
    REGISTER int n;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1100
    unsigned int u;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1101
    int val;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1102
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1103
    /* notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1104
       this can be done since basicAt: is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1105
       and SmallInteger */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1106
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1107
    if (__isSmallInteger(index)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1108
	indx = __intVal(index) - 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1109
	myClass = __qClass(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1110
	n /* ninstvars */ = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1111
	n /* nInstBytes */ = OHDR_SIZE + __OBJS2BYTES__(n /* ninstvars */);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1112
	nbytes = __qSize(self) - n /* nInstBytes */;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1113
	pFirst = (char *)(__InstPtr(self)) + n /* nInstBytes */;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1114
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1115
	switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1116
	    case __MASKSMALLINT(POINTERARRAY):
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1117
		if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1118
		    OBJ *op;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1119
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1120
		    op = (OBJ *)pFirst + indx;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1121
		    *op = anObject;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1122
		    __STORE(self, anObject);
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1123
		    RETURN ( anObject );
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1124
		}
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1125
		break;
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1126
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1127
	    case __MASKSMALLINT(WKPOINTERARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1128
		if ((unsigned)indx < (__BYTES2OBJS__(nbytes))) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1129
		    OBJ *op;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1130
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1131
		    op = (OBJ *)pFirst + indx;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1132
		    *op = anObject;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1133
		    __STORE(self, anObject);
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  1134
		    __WEAK_WRITE__(self, anObject);
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1135
		    RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1136
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1137
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1138
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1139
	    case __MASKSMALLINT(BYTEARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1140
		if (__isSmallInteger(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1141
		    val = __intVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1142
		    if ((val & ~0xFF) == 0 /* i.e. (val >= 0) && (val <= 255) */) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1143
			if ((unsigned)indx < nbytes) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1144
			    char *cp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1145
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1146
			    cp = pFirst + indx;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1147
			    *cp = val;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1148
			    RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1149
			}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1150
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1151
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1152
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1153
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1154
	    case __MASKSMALLINT(FLOATARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1155
		if ((unsigned)indx < (nbytes / sizeof(float))) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1156
		    float *fp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1157
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1158
		    fp = (float *)pFirst + indx;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1159
		    if (anObject != nil) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1160
			if (! __isSmallInteger(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1161
			    if (__qIsFloatLike(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1162
				*fp = (float)(__floatVal(anObject));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1163
				RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1164
			    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1165
			    if (__qIsShortFloat(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1166
				*fp = __shortFloatVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1167
				RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1168
			    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1169
			} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1170
			    *fp = (float) __intVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1171
			    RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1172
			}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1173
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1174
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1175
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1176
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1177
	    case __MASKSMALLINT(DOUBLEARRAY):
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1178
# ifdef __NEED_DOUBLE_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1179
		if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1180
		    int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1181
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1182
		    pFirst += delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1183
		    nbytes -= delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1184
		}
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1185
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1186
		if ((unsigned)indx < (nbytes / sizeof(double))) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1187
		    double *dp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1188
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1189
		    dp = (double *)pFirst + indx;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1190
		    if (anObject != nil) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1191
			if (! __isSmallInteger(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1192
			    if (__qIsFloatLike(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1193
				*dp = __floatVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1194
				RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1195
			    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1196
			    if (__qIsShortFloat(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1197
				*dp = (double)__shortFloatVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1198
				RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1199
			    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1200
			} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1201
			    *dp = (double) __intVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1202
			    RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1203
			}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1204
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1205
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1206
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1207
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1208
	    case __MASKSMALLINT(WORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1209
		if (__isSmallInteger(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1210
		    val = __intVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1211
		    if ((unsigned)val <= 0xFFFF) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1212
			if ((unsigned)indx < (nbytes>>1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1213
			    unsigned short *sp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1214
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1215
			    sp = (unsigned short *)(pFirst + (indx<<1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1216
			    *sp = val;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1217
			    RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1218
			}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1219
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1220
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1221
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1222
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1223
	    case __MASKSMALLINT(SWORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1224
		if (__isSmallInteger(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1225
		    val = __intVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1226
		    if ((val >= -32768) && (val < 32768)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1227
			if ((unsigned)indx < (nbytes>>1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1228
			    short *ssp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1229
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1230
			    ssp = (short *)(pFirst + (indx<<1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1231
			    *ssp = val;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1232
			    RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1233
			}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1234
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1235
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1236
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1237
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1238
	    case __MASKSMALLINT(SLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1239
		if ((unsigned)indx < (nbytes>>2)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1240
		    int32 *slp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1241
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1242
		    slp = (int32 *)(pFirst + (indx<<2));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1243
		    if (__isSmallInteger(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1244
			*slp = __intVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1245
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1246
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1247
		    n = __signedLongIntVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1248
		    /*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1249
		     * zero means failure for an int larger than INT-size bytes
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1250
		     * (would be a smallInteger)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1251
		     */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1252
		    if (n) {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1253
# if __POINTER_SIZE__ == 8
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1254
			if ((n >= -0x80000000) && (n < 0x80000000))
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1255
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1256
			{
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1257
			    *slp = n;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1258
			    RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1259
			}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1260
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1261
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1262
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1263
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1264
	    case __MASKSMALLINT(LONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1265
		if ((unsigned)indx < (nbytes>>2)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1266
		    unsigned int32 *lp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1267
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1268
		    lp = (unsigned int32 *)(pFirst + (indx<<2));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1269
		    if (anObject == __mkSmallInteger(0)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1270
			*lp = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1271
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1272
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1273
		    u = __longIntVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1274
		    /*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1275
		     * zero means failure for an int larger than 4 bytes
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1276
		     * (would be a smallInteger)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1277
		     */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1278
		    if (u) {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1279
# if __POINTER_SIZE__ == 8
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1280
			if (u <= 0xFFFFFFFF)
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1281
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1282
			{
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1283
			    *lp = u;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1284
			    RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1285
			}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1286
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1287
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1288
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1289
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1290
	    case __MASKSMALLINT(SLONGLONGARRAY):
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1291
# ifdef __NEED_LONGLONG_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1292
		if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1293
		    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1294
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1295
		    pFirst += delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1296
		    nbytes -= delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1297
		}
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1298
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1299
		if ((unsigned)indx < (nbytes>>3)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1300
		    __int64__ ll;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1301
		    __int64__ *sllp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1302
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1303
		    sllp = (__int64__ *)(pFirst + (indx<<3));
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  1304
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1305
# if __POINTER_SIZE__ == 8
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1306
		    if (__isSmallInteger(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1307
			*sllp = __intVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1308
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1309
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1310
		    n = __signedLongIntVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1311
		    if (n) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1312
			*sllp = n;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1313
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1314
		    }
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1315
# else
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1316
		    if (anObject == __mkSmallInteger(0)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1317
			ll.lo = ll.hi = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1318
			*sllp = ll;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1319
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1320
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1321
		    if (__signedLong64IntVal(anObject, &ll)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1322
			*sllp = ll;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1323
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1324
		    }
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1325
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1326
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1327
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1328
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1329
	    case __MASKSMALLINT(LONGLONGARRAY):
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1330
# ifdef __NEED_LONGLONG_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1331
		if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1332
		    int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1333
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1334
		    pFirst += delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1335
		    nbytes -= delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1336
		}
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1337
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1338
		if ((unsigned)indx < (nbytes>>3)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1339
		    __uint64__ ll;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1340
		    __uint64__ *llp;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1341
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1342
		    llp = (__uint64__ *)(pFirst + (indx<<3));
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1343
# if __POINTER_SIZE__ == 8
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1344
		    if (__isSmallInteger(anObject)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1345
			*llp = __intVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1346
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1347
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1348
		    ll = __longIntVal(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1349
		    if (ll) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1350
			*llp = ll;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1351
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1352
		    }
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1353
# else
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1354
		    if (anObject == __mkSmallInteger(0)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1355
			ll.lo = ll.hi = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1356
			*llp = ll;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1357
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1358
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1359
		    if (__unsignedLong64IntVal(anObject, &ll)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1360
			*llp = ll;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1361
			RETURN ( anObject );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1362
		    }
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1363
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1364
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1365
		break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1366
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1367
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  1368
#endif /* ! __SCHTEAM__ */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1369
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1370
    index isInteger ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1371
	"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1372
	 the index should be an integer number
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1373
	"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1374
	^ self indexNotInteger:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1375
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1376
    (index between:1 and:self size) ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1377
	"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1378
	 the index is less than 1 or greater than the size of the
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1379
	 receiver collection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1380
	"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1381
	^ self subscriptBoundsError:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1382
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1383
    (self class isFloatsOrDoubles) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1384
	anObject isNumber ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1385
	    ^ self basicAt:index put:(anObject asFloat)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1386
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1387
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1388
    anObject isInteger ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1389
	"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1390
	 the object to put into the receiver collection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1391
	 should be an integer number
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1392
	"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1393
	^ self elementNotInteger
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1394
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1395
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1396
     the object to put into the receiver collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1397
     is not an instance of the expected element class,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1398
     or the value is  not within the elements valid range.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1399
    "
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  1400
    ^ self elementBoundsError:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1401
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1402
    "Modified: 19.4.1996 / 11:14:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1403
!
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
byteAt:index
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1406
    "return the byte at index.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1407
     This is only allowed for non-pointer indexed objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1408
     (i.e. byteArrays, wordArrays, floatArrays etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1409
     The receivers indexed instvars are treated as an uninterpreted
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1410
     collection of bytes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1411
     Only useful with binary storage."
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
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1414
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1415
    REGISTER int indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1416
    int nIndex;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1417
    REGISTER OBJ slf;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1418
    REGISTER OBJ cls;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1419
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1420
    if (__isSmallInteger(index)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1421
	slf = self;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1422
	if (__isNonNilObject(slf)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1423
	    unsigned char *pFirst;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1424
	    int nIndex;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1425
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1426
	    cls = __qClass(slf);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1427
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1428
	    pFirst = __byteArrayVal(slf);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1429
	    pFirst += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1430
	    nIndex = __byteArraySize(slf);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1431
	    indx = __intVal(index) - 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1432
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1433
	    switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1434
		case __MASKSMALLINT(DOUBLEARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1435
#ifdef __NEED_DOUBLE_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1436
		    if ((INT)pFirst & (__DOUBLE_ALIGN-1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1437
			int delta = __DOUBLE_ALIGN - ((INT)pFirst & (__DOUBLE_ALIGN-1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1438
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1439
			pFirst += delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1440
			nIndex -= delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1441
		    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1442
#endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1443
		    /* fall into */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1444
		case __MASKSMALLINT(BYTEARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1445
		case __MASKSMALLINT(WORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1446
		case __MASKSMALLINT(LONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1447
		case __MASKSMALLINT(SWORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1448
		case __MASKSMALLINT(SLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1449
		case __MASKSMALLINT(FLOATARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1450
		    if ((unsigned)indx < (unsigned)nIndex) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1451
			RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1452
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1453
		    break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1454
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1455
		case __MASKSMALLINT(LONGLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1456
		case __MASKSMALLINT(SLONGLONGARRAY):
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1457
#ifdef __NEED_LONGLONG_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1458
		    if ((INT)pFirst & (__LONGLONG_ALIGN-1)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1459
			int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1460
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1461
			pFirst += delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1462
			nIndex -= delta;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1463
		    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1464
#endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1465
		    if ((unsigned)indx < (unsigned)nIndex) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1466
			RETURN ( __mkSmallInteger( (INT)(pFirst[indx])) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1467
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1468
		    break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1469
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1470
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1471
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1472
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1473
    "/ index not integer or index out of range
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1474
    "/ or non-byte indexable receiver
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
    ^ self primitiveFailed
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1479
     Point new byteAt:1
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1480
     (ByteArray with:1 with:2) byteAt:2
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1481
     (WordArray with:1) byteAt:1
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1482
     (FloatArray with:1.0) byteAt:2
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1483
     'hello' byteAt:1
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1487
byteAt:index put:byteValue
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1488
    "set the byte at index.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1489
     This is only allowed for non-pointer indexed objects
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1490
     (i.e. byteArrays, wordArrays, floatArrays etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1491
     The receivers indexed instvars are treated as an uninterpreted
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1492
     collection of bytes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1493
     Only useful with binary storage."
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
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1496
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1497
    REGISTER int indx;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1498
    int val, nIndex;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1499
    REGISTER OBJ slf;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1500
    REGISTER OBJ cls;
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
    if (__bothSmallInteger(index, byteValue)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1503
	val = __intVal(byteValue);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1504
	if ((unsigned)(val) <= 0xFF /* i.e. (val >= 0) && (val <= 255) */) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1505
	    slf = self;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1506
	    if (__isNonNilObject(slf)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1507
		cls = __qClass(slf);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1508
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1509
		indx = __intVal(index) - 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1510
		switch ((INT)(__ClassInstPtr(cls)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1511
		    case __MASKSMALLINT(BYTEARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1512
		    case __MASKSMALLINT(WORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1513
		    case __MASKSMALLINT(LONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1514
		    case __MASKSMALLINT(SWORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1515
		    case __MASKSMALLINT(SLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1516
		    case __MASKSMALLINT(LONGLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1517
		    case __MASKSMALLINT(SLONGLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1518
		    case __MASKSMALLINT(FLOATARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1519
		    case __MASKSMALLINT(DOUBLEARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1520
			indx += __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1521
			nIndex = __byteArraySize(slf);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1522
			if ((unsigned)indx < (unsigned)nIndex) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1523
			    __ByteArrayInstPtr(slf)->ba_element[indx] = val;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1524
			    RETURN ( byteValue );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1525
			}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1526
			break;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1527
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1528
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1529
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1530
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1531
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1532
    "/ index not integer or index out of range
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1533
    "/ or non-byte indexable receiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1534
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1535
    ^ self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1536
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1537
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1538
     (ByteArray with:1 with:2) byteAt:2 put:3; yourself
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1539
     'hello' copy byteAt:1 put:105; yourself
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
!
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
instVarAt:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1544
    "return a non-indexed instance variable;
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1545
     peeking into an object this way is not very object oriented
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1546
     - use with care (needed for copy, inspector etc.)"
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
%{  /* NOCONTEXT */
18254
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1549
#ifdef __SCHTEAM__
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1550
    return context._RETURN( self.instVarAt(index.intValue()-1) );
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1551
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1552
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1553
    int idx, ninstvars;
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
    if (__isSmallInteger(index)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1556
	myClass = __Class(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1557
	idx = __intVal(index) - 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1558
	/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1559
	 * do not allow returning of non-object fields.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1560
	 * if subclass did not make provisions for that,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1561
	 * we won't do so here ...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1562
	 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1563
	if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1564
	    if (idx == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1565
		RETURN ( nil )
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1566
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1567
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1568
	ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1569
	if ((idx >= 0) && (idx < ninstvars)) {
18422
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1570
	    // do not trust the ninstvars slot - verify
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1571
	    if ((__OBJS2BYTES__(ninstvars) + OHDR_SIZE) <= __qSize(self)) {
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1572
		RETURN ( __InstPtr(self)->i_instvars[idx] );
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1573
	    }
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1574
	    console_printf("[VM] warning: bad ninsts in class\n");
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1575
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1576
    }
18254
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1577
#endif /* not SCHTEAM */
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1578
%}.
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1579
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1580
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1581
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1582
instVarAt:index put:value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1583
    "change a non-indexed instance variable;
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1584
     peeking into an object this way is not very object oriented
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1585
     - use with care (needed for copy, inspector etc.)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1586
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1587
%{  /* NOCONTEXT */
18254
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1588
#ifdef __SCHTEAM__
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1589
    self.instVarAt_put(index.intValue()-1, value);
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1590
    return context._RETURN( value );
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1591
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1592
    OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1593
    int idx, ninstvars;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1594
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1595
    if (__isSmallInteger(index)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1596
	myClass = __Class(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1597
	idx = __intVal(index) - 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1598
	ninstvars = __intVal(__ClassInstPtr(myClass)->c_ninstvars);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1599
	/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1600
	 * do not allow setting of non-object fields.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1601
	 * if subclass did not make provisions for that,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1602
	 * we won't do so here ...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1603
	 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1604
	if (((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(NONOBJECT_INSTS))) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1605
	    if (idx == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1606
		RETURN ( nil )
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1607
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1608
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1609
	if ((idx >= 0) && (idx < ninstvars)) {
18422
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1610
	    // do not trust the ninstvars slot - verify
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1611
	    if ((__OBJS2BYTES__(ninstvars) + OHDR_SIZE) <= __qSize(self)) {
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1612
		__InstPtr(self)->i_instvars[idx] = value;
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1613
		__STORE(self, value);
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1614
		RETURN ( value );
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1615
	    }
d328420eef12 protect against wrong n_instvars in class
Claus Gittinger <cg@exept.de>
parents: 18404
diff changeset
  1616
	    console_printf("[VM] warning: bad ninsts in class\n");
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1617
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1618
    }
18254
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1619
#endif /* not SCHTEAM */
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1620
%}.
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  1621
    ^ self indexNotIntegerOrOutOfBounds:index
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1622
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1623
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1624
instVarNamed:name
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1625
    "return a non-indexed instance variables value by name;
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1626
     peeking into an object this way is not very object oriented
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1627
     - 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
  1628
     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
  1629
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1630
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1631
    |idx|
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1632
15449
2a27aa34e65b class: Object
Claus Gittinger <cg@exept.de>
parents: 15439
diff changeset
  1633
    idx := self class instVarIndexFor:name.
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1634
    idx isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1635
	^ self errorKeyNotFound:name.
11335
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  1636
    ].
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1637
    ^ self instVarAt:idx.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1638
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1639
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1640
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1641
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1642
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1643
     p := Point x:10 y:20.
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1644
     p instVarNamed:'cx'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1645
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1646
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1647
    "Modified: 19.4.1996 / 11:12:39 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1648
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1649
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1650
instVarNamed:name ifAbsent:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1651
    "return a non-indexed instance variables value by name,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1652
     or the value of exceptionBlock, if there is no such instance variable.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1653
     peeking into an object this way is not very object oriented
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1654
     - 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
  1655
     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
  1656
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1657
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1658
    |idx|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1659
15449
2a27aa34e65b class: Object
Claus Gittinger <cg@exept.de>
parents: 15439
diff changeset
  1660
    idx := self class instVarIndexFor:name.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1661
    idx isNil ifTrue:[^ exceptionBlock value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1662
    ^ self instVarAt:idx
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1663
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1664
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1665
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1666
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1667
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1668
     p := Point x:10 y:20.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1669
     p instVarNamed:'x'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1670
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1671
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1672
    "Created: 6.7.1996 / 23:02:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1673
    "Modified: 6.7.1996 / 23:03:41 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1674
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1675
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1676
instVarNamed:name put:value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1677
    "set a non-indexed instance variable by name;
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1678
     peeking into an object this way is not very object oriented
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1679
     - if at all, use with care (provided for protocol completeness).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1680
     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
  1681
     parsed ad runtime)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1682
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1683
    |idx|
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1684
15449
2a27aa34e65b class: Object
Claus Gittinger <cg@exept.de>
parents: 15439
diff changeset
  1685
    idx := self class instVarIndexFor:name.
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1686
    idx isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1687
	^ self errorKeyNotFound:name.
11335
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  1688
    ].
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1689
    ^ self instVarAt:idx put:value.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1690
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1691
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1692
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1693
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1694
     p := Point x:10 y:20.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1695
     p instVarNamed:'x' put:30.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1696
     p
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1697
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1698
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1699
    "Modified: 19.4.1996 / 11:12:49 / cg"
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1700
!
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1701
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1702
instVarNamed:name put:anObject ifAbsent:exceptionBlock
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1703
    "return a non-indexed instance variables value by name,
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1704
     or the value of exceptionBlock, if there is no such instance variable.
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1705
     peeking into an object this way is not very object oriented
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1706
     - use with care if at all (provided for inspectors and memory usage monitor).
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1707
     Notice, this access is very slow (because the classes instVar-description has to be
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1708
     parsed ad runtime)"
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1709
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1710
    |idx|
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1711
15449
2a27aa34e65b class: Object
Claus Gittinger <cg@exept.de>
parents: 15439
diff changeset
  1712
    idx := self class instVarIndexFor:name.
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1713
    idx isNil ifTrue:[^ exceptionBlock value].
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1714
    ^ self instVarAt:idx put:anObject.
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1715
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1716
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1717
    "
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1718
     |p|
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1719
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1720
     p := Point x:10 y:20.
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1721
     p instVarNamed:'x' put:4711 ifAbsent:[self halt:'no such instvar'].
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1722
     p instVarNamed:'bla' put:4712 ifAbsent:[self halt:'no such instvar'].
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1723
     p inspect.
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1724
    "
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1725
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1726
    "Created: 6.7.1996 / 23:02:49 / cg"
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  1727
    "Modified: 6.7.1996 / 23:03:41 / cg"
16125
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1728
!
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1729
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1730
nilAllInstvars
18254
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1731
    "overwrite all inst vars of the object with nil.
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1732
     Used by the crypto package to clear objects with
aba026de53b8 comments
Claus Gittinger <cg@exept.de>
parents: 18240
diff changeset
  1733
     keys when no longer in use."
16230
e5de942a1a19 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 16229
diff changeset
  1734
16125
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1735
%{  /* NOCONTEXT */
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1736
    int flags;
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1737
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1738
    if (!__isNonNilObject(self)) {
16230
e5de942a1a19 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 16229
diff changeset
  1739
	RETURN(self);
16125
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1740
    }
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1741
    /*
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1742
     * bail out for special (weak) objects ..
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1743
     */
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1744
    flags = __intVal(__ClassInstPtr(__qClass(self))->c_flags);
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1745
    if (((flags & ~ARRAYMASK) == 0)
16230
e5de942a1a19 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 16229
diff changeset
  1746
	&& ((flags & ARRAYMASK) != WKPOINTERARRAY)
16125
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1747
    ) {
16230
e5de942a1a19 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 16229
diff changeset
  1748
	bzero((void *)__InstPtr(self)->i_instvars, __qSize(self)-OHDR_SIZE);
e5de942a1a19 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 16229
diff changeset
  1749
	RETURN(self);
16125
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1750
    }
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1751
%}.
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1752
    "/ fail for special objects
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1753
    ^ self primitiveFailed
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1754
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1755
    "
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1756
      'abcdef' copy nilAllInstvars
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1757
      100 factorial nilAllInstvars
2096ee4fa6bd class: Object
Stefan Vogel <sv@exept.de>
parents: 16052
diff changeset
  1758
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1759
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1760
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1761
!Object methodsFor:'attributes access'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1762
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1763
objectAttributeAt:attributeKey
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1764
    "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
  1765
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1766
    | attrs |
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
    attrs := self objectAttributes.
17174
c78f65f2f43d class: Object
Stefan Vogel <sv@exept.de>
parents: 17168
diff changeset
  1769
    attrs size ~~ 0 ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1770
	^ attrs at:attributeKey ifAbsent:[]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1771
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1772
    ^ nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1773
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1774
    "Created: / 22.1.1998 / 21:29:17 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1775
    "Modified: / 3.2.1998 / 18:55:55 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1776
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1777
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1778
objectAttributeAt:attributeKey put:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1779
    "store the attribute anObject referenced by key into the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1780
16291
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1781
    "/ must do this save from being reentered, since the attributes collection
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1782
    "/ is possibly accessed from multiple threads...
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1783
    ObjectAttributesAccessLock critical:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1784
	| attrs |
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1785
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1786
	attrs := self objectAttributes.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1787
	"/ only need a WeakIdentityDictionary, if there are any non-symbol keys in
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1788
	"/ it. Start with a regular IDDict, and migrate to WeakIDDict if ever required.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1789
	"/ Typically, this never happens (but does in the UIPainter!!)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1790
	attrs isEmptyOrNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1791
	    attributeKey isSymbol ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1792
		attrs := IdentityDictionary new.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1793
	    ] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1794
		attrs := WeakIdentityDictionary new.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1795
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1796
	    attrs at:attributeKey put:anObject.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1797
	    self objectAttributes:attrs.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1798
	] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1799
	    attributeKey isSymbol ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1800
		attrs isWeakCollection ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1801
		    "first non-symbol attributeKey - convert to WeakIdentityDictionary"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1802
		    attrs := WeakIdentityDictionary new declareAllFrom:attrs.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1803
		    self objectAttributes:attrs.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1804
		].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1805
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1806
	    attrs at:attributeKey put:anObject.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1807
	].
16291
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1808
    ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1809
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1810
    "Attaching additional attributes (slots) to an arbitrary object:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1811
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1812
     |p|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1813
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1814
     p := Point new.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1815
     p objectAttributeAt:#color put:#green.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1816
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1817
     p objectAttributeAt:#color
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1818
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1819
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1820
    "Created: / 22.1.1998 / 21:29:25 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1821
    "Modified: / 3.2.1998 / 18:57:58 / cg"
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
objectAttributes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1825
    "return a Collection of attributes - nil if there is none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1826
     The default implementation here uses a global WeakDictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1827
     attributes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1828
     This may be too slow for high frequency slot access,
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  1829
     therefore, some classes may redefine this for better performnce.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1830
     Notice the mentioning of a WeakDictionary - read the classes documentation."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1831
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1832
    ^ ObjectAttributes at:self ifAbsent:[nil]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1833
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1834
    "Created: / 22.1.1998 / 21:29:30 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1835
    "Modified: / 18.2.2000 / 11:34:16 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1836
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1837
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1838
objectAttributes:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1839
    "set the collection of attributes.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1840
     The default implementation here uses a global Dictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1841
     attributes which may be too slow for high frequency change&update.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1842
     Therefore, some classes may redefine this for better performance."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1843
16291
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1844
    "/ must do this save from being reentered, since the attributes collection
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1845
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1846
16291
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1847
    ObjectAttributesAccessLock critical:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1848
	aCollection isEmptyOrNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1849
	    ObjectAttributes removeKey:self ifAbsent:nil
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1850
	] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1851
	    ObjectAttributes at:self put:aCollection
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1852
	].
5755
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
    "Created: / 22.1.1998 / 21:29:35 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1856
    "Modified: / 3.2.1998 / 18:58:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1857
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1858
6323
9dbabd4270d3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6321
diff changeset
  1859
removeObjectAttribute:attributeKey
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1860
    "make the argument, anObject be no attribute of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1861
16291
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1862
    "/ must do this save from being reentered, since the attributes collection
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1863
    "/ is possibly accessed from multiple threads.
16291
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1864
    ObjectAttributesAccessLock critical:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1865
	|attrs|
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1866
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1867
	attrs := self objectAttributes.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1868
	attrs notNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1869
	    attrs size ~~ 0 ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1870
		attrs removeKey:attributeKey ifAbsent:nil.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1871
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1872
	    attrs size == 0 ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1873
		self objectAttributes:nil
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1874
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  1875
	]
16291
5fa03fd6dd29 class: Object
Claus Gittinger <cg@exept.de>
parents: 16251
diff changeset
  1876
    ]
5755
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
    "Created: / 22.1.1998 / 21:29:39 / av"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1879
    "Modified: / 18.2.2000 / 11:32:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1880
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1881
13500
51b2e6c6c2ac changed:
Claus Gittinger <cg@exept.de>
parents: 13488
diff changeset
  1882
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1883
!Object methodsFor:'change & update'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1884
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1885
broadcast:aSelectorSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1886
    "send a message with selector aSelectorSymbol to all my dependents"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1887
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1888
    self dependentsDo:[:dependent |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1889
	dependent perform:aSelectorSymbol
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1890
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1891
!
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
broadcast:aSelectorSymbol with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1894
    "send a message with selector aSelectorSymbol with an additional
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1895
     argument anArgument to all my dependents."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1896
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1897
    self dependentsDo:[:dependent |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1898
	dependent perform:aSelectorSymbol with:anArgument
5755
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
!
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
changeRequest
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1903
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1904
     grant the request, and return true if so"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1905
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1906
    self dependentsDo:[:dependent |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1907
	dependent updateRequest ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1908
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1909
    ^ true
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
11551
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1912
changeRequest:aSymbol
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1913
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1914
     grant the request, and return true if so"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1915
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1916
    self dependentsDo:[:dependent |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1917
	(dependent updateRequest:aSymbol) ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1918
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1919
    ^ true
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
11551
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1922
changeRequest:aSymbol from:anObject
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1923
    "the receiver wants to change - check if all dependents
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1924
     except anObject grant the request, and return true if so.
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1925
     The argument anObject is typically going to be the one who is
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1926
     about to send the change request."
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1927
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1928
    ^ self changeRequest:aSymbol with:nil from:anObject
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1929
!
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1930
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1931
changeRequest:aSymbol with:aParameter
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1932
    "the receiver wants to change - check if all dependents
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1933
     grant the request, and return true if so"
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1934
11573
cc09bff8a992 *** empty log message ***
ca
parents: 11551
diff changeset
  1935
    ^ self changeRequest:aSymbol with:aParameter from:self
11551
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1936
!
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1937
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  1938
changeRequest:aSymbol with:aParameter from:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1939
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1940
     except anObject grant the request, and return true if so.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1941
     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
  1942
     about to send the change request."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1943
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1944
    self dependentsDo:[:dependent |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1945
	dependent == anObject ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1946
	    (dependent updateRequest:aSymbol with:aParameter from:anObject) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1947
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1948
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1949
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1950
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1951
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1952
changeRequestFrom:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1953
    "the receiver wants to change - check if all dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1954
     except anObject grant the request, and return true if so.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1955
     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
  1956
     about to send the change request."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1957
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1958
    self dependentsDo:[:dependent |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1959
	dependent == anObject ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1960
	    (dependent updateRequest) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1961
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1962
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1963
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1964
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1965
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1966
changed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1967
    "notify all dependents that the receiver has changed.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1968
     Each dependent gets a '#update:'-message with the original
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1969
     receiver as argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1970
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1971
    self changed:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1972
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1973
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1974
changed:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1975
    "notify all dependents that the receiver has changed somehow.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1976
     Each dependent gets a '#update:'-message with aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1977
     as argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1978
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1979
    self changed:aParameter with:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1980
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1981
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1982
changed:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1983
    "notify all dependents that the receiver has changed somehow.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1984
     Each dependent gets a  '#update:with:from:'-message, with aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1985
     and anArgument as arguments."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1986
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  1987
    self dependentsDo:[:dependent |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  1988
	dependent update:aParameter with:anArgument from:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1989
    ]
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1992
update:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1993
    "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
  1994
     on whom the receiver depends, has changed. The argument aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1995
     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
  1996
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1997
     Default behavior here is to do nothing"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1998
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  1999
    ^ self
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2002
update:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2003
    "dependent is notified of some change -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2004
     Default is to try update:"
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
    ^ self update:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2007
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2008
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2009
update:aParameter with:anArgument from:sender
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2010
    "dependent is notified of some change -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2011
     Default is to try update:with:"
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
    ^ self update:aParameter with:anArgument
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2014
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2015
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2016
updateRequest
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2017
    "return true, if an update request is granted.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2018
     Default here is to grant updates - may be used
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2019
     to lock updates if someone is making other changes
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2020
     from within an update. Or if someone has locked its
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2021
     state and does not want others to change things.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2022
     However, these dependents must all honor the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2023
     changeRequest - ifTrue - change protocol. I.e. they
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2024
     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
  2025
     it returns true. The others must decide in updateRequest and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2026
     return true if they think a change is ok."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2027
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2028
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2029
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2030
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2031
updateRequest:aSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2032
    "return true, if an update request is granted.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2033
     Default here a simple updateRequest"
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
    ^ self updateRequest
7177
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2036
!
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2037
11551
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2038
updateRequest:aSymbol with:aParameter
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2039
    "return true, if an update request is granted.
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2040
     Default here a simple updateRequest"
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2041
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2042
    ^ self updateRequest:aSymbol
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2043
!
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2044
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2045
updateRequest:aSymbol with:aParameter from:sender
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2046
    "return true, if an update request is granted.
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2047
     Default here a simple updateRequest"
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2048
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2049
    ^ self updateRequest:aSymbol with:aParameter
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2050
!
170f7fae1bfc updateRequest
Claus Gittinger <cg@exept.de>
parents: 11541
diff changeset
  2051
7177
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2052
withoutUpdating:someone do:aBlock
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2053
    "evaluate a block but remove someone from my dependents temporarily"
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2054
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2055
    (self dependents includesIdentical:someone)
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2056
    ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2057
	^ aBlock value.
7177
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2058
    ].
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2059
    self removeDependent:someone.
2bfa42d795a0 added withoutUpdating:do:
martin
parents: 7159
diff changeset
  2060
    ^ aBlock ensure:[ self addDependent:someone ]
5755
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
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  2063
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2064
!Object methodsFor:'comparing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2065
14975
0e1b93ce9851 class: Object
Claus Gittinger <cg@exept.de>
parents: 14974
diff changeset
  2066
= anObject
0e1b93ce9851 class: Object
Claus Gittinger <cg@exept.de>
parents: 14974
diff changeset
  2067
    "return true, if the receiver and the arg have the same structure.
0e1b93ce9851 class: Object
Claus Gittinger <cg@exept.de>
parents: 14974
diff changeset
  2068
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2069
	This method is partially open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2070
	identical objects are always considered equal.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2071
	redefining it may not work as expected."
14975
0e1b93ce9851 class: Object
Claus Gittinger <cg@exept.de>
parents: 14974
diff changeset
  2072
0e1b93ce9851 class: Object
Claus Gittinger <cg@exept.de>
parents: 14974
diff changeset
  2073
    ^ self == anObject
0e1b93ce9851 class: Object
Claus Gittinger <cg@exept.de>
parents: 14974
diff changeset
  2074
!
0e1b93ce9851 class: Object
Claus Gittinger <cg@exept.de>
parents: 14974
diff changeset
  2075
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2076
== anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2077
    "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
  2078
     Never redefine this in any class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2079
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2080
	This method is open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2081
	- redefining it may not work as expected."
5755
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
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  2084
#ifdef __SCHTEAM__
18361
6f4ec9a1b98a comments only
Claus Gittinger <cg@exept.de>
parents: 18352
diff changeset
  2085
    return context._RETURN( (self == anObject) ? STObject.True : STObject.False );
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  2086
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2087
    RETURN ( (self == anObject) ? true : false );
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  2088
#endif
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2089
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2090
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2091
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2092
deepSameContentsAs:anObject
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2093
    "return true, if the receiver and the arg have the same contents
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2094
     in both the named instance vars and any indexed instVars.
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2095
     This method descends into referenced objects, where #sameContentsAs: does not descend"
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2096
5821
c11bb6c8cc8f Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5814
diff changeset
  2097
    |myClass val
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2098
     sz "{ Class: SmallInteger }" |
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2099
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2100
    myClass := self class.
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2101
    myClass isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2102
	sz := self basicSize.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2103
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2104
	"compare the indexed variables"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2105
	1 to:sz do:[:i |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2106
	    val := self basicAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2107
	    val isLiteral ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2108
		val = (anObject basicAt:i) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2109
	    ] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2110
		(val deepSameContentsAs:(anObject basicAt:i)) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2111
	    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2112
	]
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2113
    ].
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2114
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2115
    "compare the instance variables"
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2116
    sz := myClass instSize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2117
    1 to:sz do:[:i |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2118
	val := self instVarAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2119
	val isLiteral ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2120
	    val = (anObject instVarAt:i) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2121
	] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2122
	    (val deepSameContentsAs:(anObject instVarAt:i)) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2123
	]
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2124
    ].
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2125
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2126
    ^ true
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
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2129
     #(1 2 3 4) deepSameContentsAs:#[1 2 3 4] asArray
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2130
     (1@2) deepSameContentsAs:(1->2)
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2131
    "
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2132
!
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2133
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2134
hash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2135
    "return an Integer useful as a hash key for the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2136
     This hash should return same values for objects with same
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2137
     contents (i.e. use this to hash on structure)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2138
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2139
    ^ self identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2140
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2141
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2142
identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2143
    "return an Integer useful as a hash key for the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2144
     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
  2145
     this to hash on identity of objects).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2146
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2147
     We cannot use the Objects address (as other smalltalks do) since
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2148
     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
  2149
     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
  2150
     Id in the object header itself as its hashed upon.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2151
     (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
  2152
     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
  2153
     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
  2154
     hashed-upon objects could add an instvar containing the hash value."
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
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2157
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  2158
    REGISTER unsigned INT hash;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2159
    static unsigned nextHash = 0;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2160
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2161
    if (__isNonNilObject(self)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2162
	hash = __GET_HASH(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2163
	if (hash == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2164
	    /* has no hash yet */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2165
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2166
	    if (++nextHash > __MAX_HASH__) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2167
		nextHash = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2168
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2169
	    hash = nextHash;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2170
	    __SET_HASH(self, hash);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2171
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2172
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2173
	/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2174
	 * now, we got 11 bits for hashing;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2175
	 * make it as large as possible; since most hashers use the returned
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2176
	 * key and take it modulo some prime number, this will allow for
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2177
	 * better distribution (i.e. bigger empty spaces) in hashed collection.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2178
	 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2179
	hash = __MAKE_HASH__(hash);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2180
	RETURN ( __mkSmallInteger(hash) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2181
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2182
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2183
    ^ 0 "never reached, since redefined in UndefinedObject and SmallInteger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2184
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2185
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2186
identityHashForBinaryStore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2187
    "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
  2188
     and does not #become something else, while the hash is used.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2189
     This is only used by the binary storage mechanism, during the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2190
     object writing phase."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2191
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2192
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2193
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  2194
    REGISTER unsigned INT hash, hash1, hash2, sz;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2195
    OBJ o;
5806
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  2196
    static unsigned INT nextHash = 0;
a7361ebe686a avoid warnings on alpha (int-size)
Claus Gittinger <cg@exept.de>
parents: 5769
diff changeset
  2197
    static unsigned INT nextClassHash = 0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2198
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2199
    if (__isNonNilObject(self)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2200
	/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2201
	 * my own identityHash
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2202
	 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2203
	hash1 = __GET_HASH(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2204
	if (hash1 == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2205
	    /* has no hash yet */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2206
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2207
	    if (++nextHash > __MAX_HASH__) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2208
		nextHash = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2209
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2210
	    hash1 = nextHash;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2211
	    __SET_HASH(self, hash1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2212
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2213
	/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2214
	 * my classes identityHash
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2215
	 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2216
	o = __qClass(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2217
	hash2 = __GET_HASH(o);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2218
	if (hash2 == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2219
	    /* has no hash yet */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2220
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2221
	    if (++nextClassHash > __MAX_HASH__) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2222
		nextClassHash = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2223
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2224
	    hash2 = nextClassHash;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2225
	    __SET_HASH(o, hash2);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2226
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2227
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2228
	/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2229
	 * some bits of my size
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2230
	 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2231
	sz = __qSize(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2232
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2233
	/*
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2234
	 * now, we got 11 + 11 + 8 bits for hashing;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2235
	 * make it as large as possible; since most hashers use the returned
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2236
	 * key and take it modulo some prime number, this will allow for
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2237
	 * better distribution (i.e. bigger empty spaces) in hashed collection.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2238
	 */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2239
	hash = (hash1 << 11) | hash2;           /* 22 bits */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2240
	hash = (hash << 8) | (sz & 0xFC);       /* 30 bits */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2241
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2242
	while ((hash & 0x20000000) == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2243
	    hash <<= 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2244
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2245
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2246
	RETURN ( __mkSmallInteger(hash) );
5755
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
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2249
    "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
  2250
    ^ self identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2251
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2252
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2253
sameContentsAs:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2254
    "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
  2255
     in both the named instance vars and any indexed instVars.
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2256
     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
  2257
     present in the arg, not vice versa.
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2258
     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
  2259
5821
c11bb6c8cc8f Cleanup unused method vars
Stefan Vogel <sv@exept.de>
parents: 5814
diff changeset
  2260
    |myClass
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2261
     sz "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2262
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2263
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2264
    myClass isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2265
	sz := self basicSize.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2266
	anObject basicSize >= sz ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2267
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2268
	"compare the indexed variables"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2269
	1 to:sz do:[:i |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2270
	    (self basicAt:i) == (anObject basicAt:i) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2271
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2272
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2273
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2274
    "compare the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2275
    sz := myClass instSize.
12997
11e3305c4a0c changed: #sameContentsAs:
sr
parents: 12841
diff changeset
  2276
    anObject class instSize >= sz ifFalse:[^ false].
7121
5ce61b826f0e sameContentsAs: comment.
Claus Gittinger <cg@exept.de>
parents: 7112
diff changeset
  2277
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2278
    1 to:sz do:[:i |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2279
	(self instVarAt:i) == (anObject instVarAt:i) ifFalse:[^ false].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2280
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2281
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2282
    ^ true
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
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2285
     #(1 2 3 4) sameContentsAs:#[1 2 3 4] asArray
5814
f4f6da3e7631 Define #deepSameContentsAs:
Stefan Vogel <sv@exept.de>
parents: 5806
diff changeset
  2286
     (1@2) sameContentsAs:(1->2)
5755
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
12997
11e3305c4a0c changed: #sameContentsAs:
sr
parents: 12841
diff changeset
  2289
    "Created: / 21-04-1998 / 15:56:40 / cg"
11e3305c4a0c changed: #sameContentsAs:
sr
parents: 12841
diff changeset
  2290
    "Modified: / 05-08-2010 / 16:44:09 / sr"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2291
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2292
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2293
~= anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2294
    "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
  2295
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2296
	This method is partially open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2297
	identical objects are never considered unequal.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2298
	redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2299
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2300
    ^ (self = anObject) not
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2301
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2302
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2303
~~ anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2304
    "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
  2305
     Never redefine this in any class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2306
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2307
	This method is open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2308
	- redefining it may not work as expected."
5755
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
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  2311
#ifdef __SCHTEAM__
18361
6f4ec9a1b98a comments only
Claus Gittinger <cg@exept.de>
parents: 18352
diff changeset
  2312
    return context._RETURN( (self == anObject) ? STObject.False : STObject.True );
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  2313
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2314
    RETURN ( (self == anObject) ? false : true );
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  2315
#endif
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2316
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2317
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2318
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2319
!Object methodsFor:'converting'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2320
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2321
-> anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2322
    "return an association with the receiver as key and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2323
     the argument as value"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2324
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2325
    ^ Association key:self value:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2326
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2327
10062
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2328
as:aSimilarClass
16052
04691ede1f57 class: Object
Claus Gittinger <cg@exept.de>
parents: 16021
diff changeset
  2329
    "If the receiver's class is not aSimilarClass,
04691ede1f57 class: Object
Claus Gittinger <cg@exept.de>
parents: 16021
diff changeset
  2330
     create and return an instance of aSimilarClass that has the same contents
10062
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2331
     as the receiver.
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2332
     Otherwise, return the receiver."
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2333
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2334
    self class == aSimilarClass ifTrue:[^ self].
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2335
    ^ aSimilarClass newFrom:self
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2336
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2337
    "
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2338
     #[1 2 3 4] as:ByteArray
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2339
     #[1 2 3 4] as:Array
10539
05541b0358c2 changed #as: comment
Stefan Vogel <sv@exept.de>
parents: 10532
diff changeset
  2340
     #[81 82 83 84] as:String
05541b0358c2 changed #as: comment
Stefan Vogel <sv@exept.de>
parents: 10532
diff changeset
  2341
     #[81 82 83 84] as:Symbol
16052
04691ede1f57 class: Object
Claus Gittinger <cg@exept.de>
parents: 16021
diff changeset
  2342
     'hello' as:Unicode16String
10062
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2343
    "
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2344
!
c84adfadde12 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10032
diff changeset
  2345
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2346
asCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2347
    "return myself as a Collection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2348
     Redefined in collection to return themself."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2349
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2350
    ^ Array with:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2351
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2352
17261
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
  2353
asLink
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
  2354
    "return a valueLink for the receiver.
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
  2355
     Used to make sure the receiver can be added to a linked list"
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
  2356
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
  2357
    ^ ValueLink value:self
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
  2358
!
a9bf1e05e5a2 class: Object
Claus Gittinger <cg@exept.de>
parents: 17176
diff changeset
  2359
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2360
asSequenceableCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2361
    "return myself as a SequenceableCollection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2362
     Redefined in SequenceableCollection"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2363
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2364
    ^ Array with:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2365
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2366
14355
b5ed6aa393f7 added: #asUnicode16String
Stefan Vogel <sv@exept.de>
parents: 14296
diff changeset
  2367
asString
b5ed6aa393f7 added: #asUnicode16String
Stefan Vogel <sv@exept.de>
parents: 14296
diff changeset
  2368
    ^ self printString
b5ed6aa393f7 added: #asUnicode16String
Stefan Vogel <sv@exept.de>
parents: 14296
diff changeset
  2369
!
b5ed6aa393f7 added: #asUnicode16String
Stefan Vogel <sv@exept.de>
parents: 14296
diff changeset
  2370
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2371
asValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2372
    "return a valueHolder for for the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2373
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2374
    ^ ValueHolder with:self
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2377
!Object methodsFor:'copying'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2378
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2379
cloneFrom:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2380
    "Helper for copy:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2381
     copy all instance variables from anObject into the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2382
     which should be of the same class as the argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2383
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2384
    self cloneFrom:anObject performing:#yourself
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2385
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2386
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2387
     |x|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2388
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2389
     x := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2390
     x cloneFrom:#(1 2 3).
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2394
cloneFrom:anObject performing:aSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2395
    "Helper for copy:
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2396
     for each instance variable from anObject, send it aSymbol
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2397
     and store the result into the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2398
     which should be of the same class as the argument."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2399
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2400
    |myClass sz "{ Class: SmallInteger }" t |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2401
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2402
    myClass := self class.
14532
f15633aab0fe class: Object
Stefan Vogel <sv@exept.de>
parents: 14527
diff changeset
  2403
f15633aab0fe class: Object
Stefan Vogel <sv@exept.de>
parents: 14527
diff changeset
  2404
    "process the named instance variables"
f15633aab0fe class: Object
Stefan Vogel <sv@exept.de>
parents: 14527
diff changeset
  2405
    sz := myClass instSize.
f15633aab0fe class: Object
Stefan Vogel <sv@exept.de>
parents: 14527
diff changeset
  2406
    1 to:sz do:[:i |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2407
	t := anObject instVarAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2408
	aSymbol ~~ #yourself ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2409
	    t := t perform:aSymbol
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2410
	].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2411
	self instVarAt:i put:t
14532
f15633aab0fe class: Object
Stefan Vogel <sv@exept.de>
parents: 14527
diff changeset
  2412
    ].
f15633aab0fe class: Object
Stefan Vogel <sv@exept.de>
parents: 14527
diff changeset
  2413
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2414
    myClass isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2415
	sz := self basicSize.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2416
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2417
	"process the indexed instance variables"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2418
	1 to:sz do:[:i |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2419
	    t := anObject basicAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2420
	    aSymbol ~~ #yourself ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2421
		t := t perform:aSymbol.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2422
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2423
	    self basicAt:i put:t.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2424
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2425
    ].
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.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2432
     The variable slots are copied as available
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2433
     (i.e. the min of both indexed sizes is used)."
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2434
14676
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2435
    |myClass prototypesClass myInfo prototypesInfo|
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2436
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2437
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2438
    myClass := self class.
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2439
    prototypesClass := aPrototype class.
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2440
    (myClass == prototypesClass
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2441
    or:[ myClass isSubclassOf:prototypesClass ]) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2442
	"/ can do better, if my class is a subclass of the prototype's class
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2443
	1 to: prototypesClass instSize do:[:index |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2444
	    self instVarAt:index put:(aPrototype instVarAt:index)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2445
	]
14676
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2446
    ] ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2447
	"/ map instvars by name
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2448
	myInfo := myClass instanceVariableOffsets.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2449
	prototypesInfo := prototypesClass instanceVariableOffsets.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2450
	myInfo keysAndValuesDo:[:name :index | |varIndexAssoc|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2451
	    varIndexAssoc := prototypesInfo at:name ifAbsent:[].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2452
	    varIndexAssoc notNil ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2453
		self instVarAt:index put:(aPrototype instVarAt:(varIndexAssoc value))
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2454
	    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2455
	]
14676
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2456
    ].
07174f47f540 class: Object
Claus Gittinger <cg@exept.de>
parents: 14661
diff changeset
  2457
    myClass isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2458
	prototypesClass isVariable ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2459
	    1 to:(self basicSize min:aPrototype basicSize) do:[:index |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2460
		self basicAt:index put:(aPrototype basicAt:index)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2461
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2462
	].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2463
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2464
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2465
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2466
     Class withoutUpdatingChangesDo:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2467
	|point3D|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2468
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2469
	point3D := Point subclass:#Point3D
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2470
	   instanceVariableNames:'z'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2471
	   classVariableNames:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2472
	   poolDictionaries:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2473
	   category:'testing'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2474
	   inEnvironment:nil.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2475
	 (point3D new cloneInstanceVariablesFrom:1@2) inspect.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2476
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2477
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2478
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2479
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2480
     Class withoutUpdatingChangesDo:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2481
	 Point variableSubclass:#Point3D_test
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2482
	   instanceVariableNames:'z'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2483
	   classVariableNames:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2484
	   poolDictionaries:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2485
	   category:'testing'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2486
	 (((Smalltalk at:#Point3D_test) new:2) cloneInstanceVariablesFrom:#(1 2 3)) inspect.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2487
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2488
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2489
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
     |someObject|
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
     Class withoutUpdatingChangesDo:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2494
	 Object subclass:#TestClass1
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2495
	   instanceVariableNames:'foo bar'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2496
	   classVariableNames:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2497
	   poolDictionaries:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2498
	   category:'testing'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2499
	 someObject := TestClass1 new.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2500
	 someObject instVarAt:1 put:'foo'; instVarAt:2 put:'bar'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2501
	 Object subclass:#TestClass2
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2502
	   instanceVariableNames:'bar foo'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2503
	   classVariableNames:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2504
	   poolDictionaries:''
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2505
	   category:'testing'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2506
	 (TestClass2 new cloneInstanceVariablesFrom:someObject) inspect.
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2510
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2511
     |top b b1|
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
     top := StandardSystemView new.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2514
     top extent:100@100.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2515
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2516
     b := Button in:top.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2517
     b label:'hello'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2518
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2519
     b1 := ArrowButton new cloneInstanceVariablesFrom:b.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2520
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2521
     top open.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2522
     b1 inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2523
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2524
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2525
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2526
copy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2527
    "return a copy of the receiver - defaults to shallowcopy here.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2528
     Notice, that copy does not copy dependents."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2529
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2530
    ^ self shallowCopy postCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2531
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2532
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2533
copyToLevel:level
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2534
    "a controlled deepCopy, where the number of levels can be specified.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2535
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2536
	 This method DOES NOT handle cycles/self-refs and does NOT preserve object identity;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2537
	 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
  2538
14534
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2539
    |newObject newLevel class sz "{Class: SmallInteger}" newInst|
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2540
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2541
    newObject := self copy.
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2542
    newObject == self ifTrue: [^ self].   "copy of nil, true, false, ... is self"
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2543
    level == 1 ifTrue:[^ newObject].
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2544
    newLevel := level - 1.
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2545
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2546
    class := newObject class.
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2547
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2548
    "process the named instance variables"
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2549
    sz := class instSize.
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2550
    1 to:sz do:[:i |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2551
	newInst := newObject instVarAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2552
	newInst notNil ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2553
	    newObject instVarAt:i put:(newInst copyToLevel:newLevel).
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2554
	].
14534
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2555
    ].
5c9bbb0cc2ba class: Object
Stefan Vogel <sv@exept.de>
parents: 14532
diff changeset
  2556
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2557
    class isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2558
	sz := newObject basicSize.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2559
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2560
	"process the indexed instance variables"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2561
	1 to:sz do:[:i |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2562
	    newInst := newObject basicAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2563
	    newInst notNil ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2564
		newObject basicAt:i put:(newInst copyToLevel:newLevel).
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2565
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2566
	]
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2567
    ].
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2568
    ^ newObject
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
    "
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2571
     |a b|
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2572
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2573
     a := #(
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2574
	    '1.1'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2575
	    '1.2'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2576
	    '1.3'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2577
	    (
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2578
		'1.41'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2579
		'1.42'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2580
		'1.43'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2581
		    (
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2582
			'1.441'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2583
			'1.442'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2584
			'1.443'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2585
			( '1.4441' '1.4442' '1.4443' )
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2586
			'1.445'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2587
		    )
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2588
		'1.45'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2589
	    )
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2590
	    '1.5'
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2591
	   ).
6962
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2592
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2593
      b := a copyToLevel:1.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2594
      self assert: ( (a at:1) == (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2595
      self assert: ( (a at:4) == (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2596
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2597
      b := a copyToLevel:2.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2598
      self assert: ( (a at:1) ~~ (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2599
      self assert: ( (a at:4) ~~ (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2600
      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
  2601
      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
  2602
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2603
      b := a copyToLevel:3.
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2604
      self assert: ( (a at:1) ~~ (b at:1) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2605
      self assert: ( (a at:4) ~~ (b at:4) ).
eab0d4c42375 copyToLevel: example and comment
Claus Gittinger <cg@exept.de>
parents: 6961
diff changeset
  2606
      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
  2607
      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
  2608
      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
  2609
      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
  2610
    "
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2611
!
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  2612
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2613
deepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2614
    "return a copy of the object with all subobjects also copied.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2615
     This method DOES handle cycles/self-refs and preserves object identity;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2616
     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
  2617
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2618
     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
  2619
     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
  2620
     copied object does not include duplicates (or you do not care) and
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2621
     no cycles are involved, you can use the old simpleDeepCopy,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2622
     which avoids this overhead (but may run into trouble).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2623
     Notice, that deepCopy does not copy dependents."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2624
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2625
    ^ self deepCopyUsing:(IdentityDictionary new)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2626
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2627
    "an example which is not handled by the old deepCopy:
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2628
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2629
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2630
     a := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2631
     a at:3 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2632
     a deepCopy inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2633
    "
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2636
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2637
     a := Color black onDevice:Screen current.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2638
     a deepCopy inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2639
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2640
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2641
    "Modified: 27.3.1996 / 16:31:20 / stefan"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2644
deepCopyError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2645
    "{ Pragma: +optSpace }"
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
    "raise a signal, that deepCopy is not allowed for this object"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2648
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  2649
    ^ DeepCopyError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2650
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2651
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2652
deepCopyUsing:aDictionary
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2653
    "a helper for deepCopy; return a copy of the object with
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2654
     all subobjects also copied. If the to-be-copied object is in the dictionary,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2655
     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
  2656
     This method DOES handle cycles/self references."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2657
10941
f80dfc67dc51 deepCopy change
ab
parents: 10922
diff changeset
  2658
    ^ self deepCopyUsing:aDictionary postCopySelector:#postDeepCopyFrom:.
f80dfc67dc51 deepCopy change
ab
parents: 10922
diff changeset
  2659
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2660
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2661
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2662
     |a b c copyOfC|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2663
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2664
     a := Array with:'hello' with:'world' with:nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2665
     b := 99 @ 999.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2666
     a at:3 put:b.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2667
     c := Array with:a with:b with:a.
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
     Transcript showCR: (c at:1) == (c at:3).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2670
     copyOfC := c deepCopy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2671
     Transcript showCR: (copyOfC at:1) == (copyOfC at:3)
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2674
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2675
deepCopyUsing:aDictionary postCopySelector:postCopySelector
11335
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  2676
    "a helper for deepCopy; return a copy of the object with
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  2677
     all subobjects also copied. If the to-be-copied object is in the dictionary,
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2678
     use the value found there. The class of the receiver is not copied.
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2679
     This method DOES handle cycles/self references."
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2680
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2681
    |myClass aCopy
14527
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2682
     basicSize "{ Class: SmallInteger }"
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2683
     instSize  "{ Class: SmallInteger }"
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2684
     iOrig iCopy|
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2685
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2686
    myClass := self class.
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2687
    myClass isVariable ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2688
	basicSize := self basicSize.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2689
	aCopy := self speciesForCopy basicNew:basicSize.
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2690
    ] ifFalse:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2691
	basicSize := 0.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2692
	aCopy := self speciesForCopy basicNew
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2693
    ].
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2694
    aCopy setHashFrom:self.
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2695
    aDictionary at:self put:aCopy.
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2696
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2697
    "
14527
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2698
     copy the instance variables
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2699
    "
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2700
    instSize := myClass instSize.
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2701
    1 to:instSize do:[:i |
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2702
	(self skipInstvarIndexInDeepCopy:i) ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2703
	    iOrig := self instVarAt:i.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2704
	    iOrig notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2705
		iCopy := aDictionary at:iOrig ifAbsent:nil.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2706
		iCopy isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2707
		    iCopy := iOrig deepCopyUsing:aDictionary postCopySelector:postCopySelector
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2708
		].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2709
		aCopy instVarAt:i put:iCopy
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2710
	    ]
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2711
	]
14527
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2712
    ].
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2713
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2714
    "
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2715
     copy indexed instvars - if any
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2716
    "
14527
b933e9f1e53d class: Object
Stefan Vogel <sv@exept.de>
parents: 14499
diff changeset
  2717
    basicSize ~~ 0 ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2718
	myClass isBits ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2719
	    "block-copy indexed instvars"
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2720
	    aCopy replaceFrom:1 to:basicSize with:self startingAt:1
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2721
	] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2722
	    "individual deep copy the indexed variables"
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2723
	    1 to:basicSize do:[:i |
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2724
		iOrig := self basicAt:i.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2725
		iOrig notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2726
		    "/ used to be dict-includesKey-ifTrue[dict-at:],
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2727
		    "/ changed to use dict-at:ifAbsent:, to avoid double lookup in dictionary
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2728
		    iCopy := aDictionary at:iOrig ifAbsent:nil.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2729
		    iCopy isNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2730
			iCopy := iOrig deepCopyUsing:aDictionary postCopySelector:postCopySelector
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2731
		    ].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2732
		    aCopy basicAt:i put:iCopy
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2733
		]
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2734
	    ]
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  2735
	]
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2736
    ].
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2737
13515
2c1e968842cb changed: #deepCopyUsing:postCopySelector:
Claus Gittinger <cg@exept.de>
parents: 13500
diff changeset
  2738
    aCopy perform:postCopySelector withOptionalArgument:self and:aDictionary.
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2739
    ^ aCopy
13515
2c1e968842cb changed: #deepCopyUsing:postCopySelector:
Claus Gittinger <cg@exept.de>
parents: 13500
diff changeset
  2740
2c1e968842cb changed: #deepCopyUsing:postCopySelector:
Claus Gittinger <cg@exept.de>
parents: 13500
diff changeset
  2741
    "Modified: / 21-07-2011 / 13:30:52 / cg"
10954
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2742
!
b0d7bbc8673d deepCopyUsing:postCopySelector: in libbasic
sr
parents: 10941
diff changeset
  2743
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2744
postCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2745
    "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
  2746
     cleanup after copying, while ST/X passes the original in postCopyFrom:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2747
     (see there)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2748
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2749
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2750
!
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
postDeepCopy
8930
edd42af66c0a deepCopy should not invoke postCopy
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2753
    "allows for cleanup after deep copying.
edd42af66c0a deepCopy should not invoke postCopy
Claus Gittinger <cg@exept.de>
parents: 8913
diff changeset
  2754
     To be redefined in subclasses."
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2757
postDeepCopyFrom:aSource
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2758
    "allows for cleanup after deep copying"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2759
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2760
    ^ self postDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2761
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2762
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2763
setHashFrom:anObject
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2764
    "set my identity-hash key to be the same as anObjects hash key.
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2765
     This is an ST/X speciality, which is NOT available in other (especially OT based)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2766
     Smalltalks, and may not be available in future ST/X versions.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2767
     DO NEVER use this for normal application code."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2768
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2769
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2770
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2771
    REGISTER unsigned h;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2772
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2773
    if (__isNonNilObject(self) && __isNonNilObject(anObject)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2774
	h = __GET_HASH(anObject);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2775
	__SET_HASH(self, h);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2776
	RETURN (self);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2777
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2778
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2779
    self primitiveFailed    "neither receiver not arg may be nil or SmallInteger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2780
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2781
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2782
shallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2783
    "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
  2784
     i.e. the copy shares referenced instvars with its original."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2785
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2786
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2787
    int ninsts, spc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2788
    int sz;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2789
    OBJ theCopy;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2790
    OBJ cls;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2791
    int flags;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2792
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2793
    cls = __qClass(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2794
    flags = __intVal(__ClassInstPtr(cls)->c_flags);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2795
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2796
    /*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2797
     * bail out for special objects ..
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2798
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2799
    if (((flags & ~ARRAYMASK) == 0)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2800
     && ((flags & ARRAYMASK) != WKPOINTERARRAY)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2801
	sz = __qSize(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2802
	__PROTECT__(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2803
	__qNew(theCopy, sz);    /* OBJECT ALLOCATION */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2804
	__UNPROTECT__(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2805
	if (theCopy) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2806
	    cls = __qClass(self);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2807
	    spc = __qSpace(theCopy);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2808
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2809
	    theCopy->o_class = cls; __STORE_SPC(theCopy, cls, spc);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2810
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2811
	    sz = sz - OHDR_SIZE;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2812
	    if (sz) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2813
		char *src, *dst;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2814
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2815
		src = (char *)(__InstPtr(self)->i_instvars);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2816
		dst = (char *)(__InstPtr(theCopy)->i_instvars);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2817
#ifdef bcopy4
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2818
		{
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2819
		    /* care for odd-number of longs */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2820
		    int nW = sz >> 2;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2821
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2822
		    if (sz & 3) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2823
			nW++;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2824
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2825
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2826
		    bcopy4(src, dst, nW);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2827
		}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2828
#else
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2829
		bcopy(src, dst, sz);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2830
#endif
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2831
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2832
		flags &= ARRAYMASK;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2833
		if (flags == POINTERARRAY) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2834
		    ninsts = __BYTES2OBJS__(sz);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2835
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2836
		    ninsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2837
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2838
		if (ninsts) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2839
		    do {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2840
			OBJ el;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2841
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2842
			el = __InstPtr(theCopy)->i_instvars[ninsts-1];
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2843
			__STORE_SPC(theCopy, el, spc);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2844
		    } while (--ninsts);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2845
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2846
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2847
	    RETURN (theCopy);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2848
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2849
    }
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
    "/ fallBack for special objects & memoryAllocation failure case
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
    ^ self slowShallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2854
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2855
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2856
simpleDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2857
    "return a copy of the object with all subobjects also copied.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  2858
     This method does NOT handle cycles - but is included to allow this
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2859
     slightly faster copy in situations where it is known that
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2860
     no recursive references occur (LargeIntegers for example).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2861
     NOTICE: you will run into trouble, when trying this with recursive
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2862
     objects (usually recursionInterrupt or memory-alert).
8383
dea5311899c5 comments in copy methods
Claus Gittinger <cg@exept.de>
parents: 8377
diff changeset
  2863
     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
  2864
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2865
    |myClass aCopy|
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
    (myClass := self class) isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2868
	aCopy := myClass basicNew:(self basicSize).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2869
    ] ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2870
	aCopy := myClass basicNew
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2873
    "copy the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2874
    aCopy cloneFrom:self performing:#simpleDeepCopy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2875
    ^ aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2876
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2877
    "a bad example (but ST/X should survive ...)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2878
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2879
     |a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2880
     a := Array new:3.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2881
     a at:3 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2882
     a simpleDeepCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2883
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2884
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2885
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2886
skipInstvarIndexInDeepCopy:index
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2887
    "a helper for deepCopy; only indices for which this method returns
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2888
     false are copied in a deep copy.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2889
     The default is false here - which means that everything is copied.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2890
     Can be redefined in subclasses for partial copies"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2891
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2892
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2893
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2894
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2895
slowShallowCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2896
    "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
  2897
     i.e. the copy shares referenced instvars with its original.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2898
     This method is only invoked as a fallback from #shallowCopy."
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
    |myClass aCopy|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2901
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2902
    (myClass := self class) isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2903
	aCopy := myClass basicNew:(self basicSize).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2904
    ] ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2905
	aCopy := myClass basicNew
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2906
    ].
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
    "copy the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2909
    aCopy cloneFrom:self performing:#yourself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2910
    ^ aCopy
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2911
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2912
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2913
!Object methodsFor:'debugging'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2914
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2915
assert:aBooleanOrBlock
13800
2f04da6f127e comment/format in: #assert:
Stefan Vogel <sv@exept.de>
parents: 13710
diff changeset
  2916
    "fail and report an error, if the argument does not evaluate to true"
6964
a9ecdb3f1e52 comments
Claus Gittinger <cg@exept.de>
parents: 6963
diff changeset
  2917
11662
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2918
    "{ Pragma: +optSpace }"
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2919
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  2920
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  2921
8876
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2922
    aBooleanOrBlock == true ifTrue:[^ self].
17437
9662511375cf class: Object
Claus Gittinger <cg@exept.de>
parents: 17429
diff changeset
  2923
    (Smalltalk ignoreAssertions) ifTrue:[^ self].
11044
fa13d9423e71 allow for encounteredBreakPoints to be monitored
Claus Gittinger <cg@exept.de>
parents: 11025
diff changeset
  2924
8876
dc094269db8e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8872
diff changeset
  2925
    "/ could still be a block or false.
11662
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2926
    (aBooleanOrBlock value) ifFalse:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  2927
	AssertionFailedError
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  2928
	    raiseRequestWith:self
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  2929
	    errorString:('Assertion failed in ',
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  2930
			 thisContext methodHome sender printString,
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  2931
			 '[', thisContext  methodHome sender lineNumber printString,']')
11662
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2932
    ].
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2933
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2934
    "
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2935
     self assert:false
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2936
    "
13039
43313704ee61 changed: #assert:
Claus Gittinger <cg@exept.de>
parents: 12997
diff changeset
  2937
43313704ee61 changed: #assert:
Claus Gittinger <cg@exept.de>
parents: 12997
diff changeset
  2938
    "Modified: / 20-08-2010 / 17:13:06 / cg"
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2939
!
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2940
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2941
assert:aBooleanOrBlock message:messageIfFailing
11044
fa13d9423e71 allow for encounteredBreakPoints to be monitored
Claus Gittinger <cg@exept.de>
parents: 11025
diff changeset
  2942
    "fail, if the argument does not evaluate to true and report an error"
6961
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2943
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2944
    "{ Pragma: +optSpace }"
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2945
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  2946
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  2947
11141
b96ed3ac5825 assertions can be globally disabled
Claus Gittinger <cg@exept.de>
parents: 11132
diff changeset
  2948
    aBooleanOrBlock == true ifTrue:[^ self].
17437
9662511375cf class: Object
Claus Gittinger <cg@exept.de>
parents: 17429
diff changeset
  2949
    (Smalltalk ignoreAssertions) ifTrue:[^ self].
9662511375cf class: Object
Claus Gittinger <cg@exept.de>
parents: 17429
diff changeset
  2950
9662511375cf class: Object
Claus Gittinger <cg@exept.de>
parents: 17429
diff changeset
  2951
    "/ could still be a block or false.
7621
42fb582ea36b allow for blocks in assert
Claus Gittinger <cg@exept.de>
parents: 7600
diff changeset
  2952
    (aBooleanOrBlock value) ifFalse:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  2953
	AssertionFailedError
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  2954
	    raiseRequestWith:self
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  2955
	    errorString:(messageIfFailing, ' {',thisContext methodHome sender "methodHome" printString,' }')
11662
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2956
    ].
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2957
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2958
    "
08309a406658 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11634
diff changeset
  2959
     self assert:false message:'xxx'
10651
b205dbfea7e5 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10576
diff changeset
  2960
    "
14046
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  2961
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  2962
    "Modified (comment): / 06-03-2012 / 11:26:48 / cg"
6961
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2963
!
096ca5ceb662 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6954
diff changeset
  2964
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2965
basicInspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2966
    "{ Pragma: +optSpace }"
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
    "launch an inspector on the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2969
     this method should NOT be redefined in subclasses."
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
    Inspector isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2972
	"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2973
	 for systems without GUI
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2974
	"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2975
	self warn:'No Inspector defined (Inspector is nil).'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2976
    ] ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2977
	Inspector openOn:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2978
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2979
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2980
    "Modified: 18.5.1996 / 15:43:25 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2981
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  2982
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  2983
breakPoint:someKey
6954
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2984
    "{ Pragma: +optSpace }"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2985
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2986
    "Like halt, but disabled by default.
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2987
     Can be easily enabled.
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2988
     Can be filtered on the arguments value (typically: a symbol).
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2989
     Code with breakpoints may be even checked into the source repository"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2990
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2991
    "Example:   nil breakPoint:#stefan"
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  2992
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  2993
    <resource: #skipInDebuggersWalkBack>
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  2994
11048
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  2995
    "/ dont send #breakPoint:info: here - ask cg why.
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  2996
    (self isBreakPointEnabled:someKey) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2997
	^ HaltSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2998
	    raiseRequestWith:someKey
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  2999
	    errorString:('Breakpoint encountered: %1' bindWith:someKey)
11048
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3000
    ].
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3001
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3002
    "
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3003
     nil breakPoint:#stefan
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3004
     nil breakPoint:#stefan info:'Hello'
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3005
     Smalltalk enableBreakPoint:#stefan.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3006
     Smalltalk disableBreakPoint:#stefan.
11048
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3007
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3008
     EncounteredBreakPoints.
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3009
     Smalltalk enableBreakPoint:#cg.
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3010
     Smalltalk disableBreakPoint:#cg.
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3011
    "
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3012
!
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3013
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3014
breakPoint:someKey info:infoString
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3015
    "{ Pragma: +optSpace }"
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3016
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3017
    "Like halt, but disabled by default.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3018
     Can be easily enabled.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3019
     Can be filtered on the arguments value (typically: a symbol).
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3020
     Code with breakpoints may be even checked into the source repository"
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3021
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3022
    "Example:   nil breakPoint:#stefan"
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3023
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3024
    <resource: #skipInDebuggersWalkBack>
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3026
    (self isBreakPointEnabled:someKey) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3027
	^ HaltSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3028
	    raiseRequestWith:someKey
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3029
	    errorString:(infoString bindWith:someKey)
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3030
    ].
6954
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  3031
!
c3408e945eb5 oops - breakpoint lost
Claus Gittinger <cg@exept.de>
parents: 6950
diff changeset
  3032
11244
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3033
debuggingCodeFor:someKey is:aBlock
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3034
    "{ Pragma: +optSpace }"
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3035
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3036
    "aBlock is evaluated if breakPoints for somekey are enabled.
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3037
     Allows for debugging code to be enabled/disabled via the breakpoint browser.
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3038
     Can be easily enabled.
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3039
     Can be filtered on the arguments value (typically: a symbol).
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3040
     Code with breakpoints may be even checked into the source repository"
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3041
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3042
    "Example:   nil debuggingCodeFor:#cg is:[ self halt ]"
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3043
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3044
    <resource: #skipInDebuggersWalkBack>
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3045
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3046
    (self isBreakPointEnabled:someKey) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3047
	aBlock value
11244
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3048
    ].
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3049
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3050
    "
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3051
     Smalltalk disableBreakPoint:#cg.
12340
e9ea989ffe01 comment/format in: #debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 12328
diff changeset
  3052
     nil debuggingCodeFor:#cg is:[ Transcript showCR:'here is some debug message for cg' ].
e9ea989ffe01 comment/format in: #debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 12328
diff changeset
  3053
     nil debuggingCodeFor:#stefan is:[ Transcript showCR:'here is some debug message for sv' ].
11244
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3054
     Smalltalk enableBreakPoint:#cg.
12340
e9ea989ffe01 comment/format in: #debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 12328
diff changeset
  3055
     nil debuggingCodeFor:#cg is:[ Transcript showCR:'here is some debug message for cg' ].
e9ea989ffe01 comment/format in: #debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 12328
diff changeset
  3056
     nil debuggingCodeFor:#stefan is:[ Transcript showCR:'here is some debug message for sv' ].
11244
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3057
     Smalltalk disableBreakPoint:#cg.
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3058
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3059
    "
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3060
!
7ecd4a866064 debuggingCodeFor:is:
Claus Gittinger <cg@exept.de>
parents: 11236
diff changeset
  3061
14046
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3062
disableAllBreakPoints
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3063
    "disable all parametrized breakPoints (with any key as parameter)"
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3064
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3065
    EnabledBreakPoints := nil
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3066
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3067
    "
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3068
     nil enableBreakPoint:#cg.
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3069
     nil breakPoint:#cg.
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3070
     nil disableAllBreakPoints.
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3071
     nil breakPoint:#cg.
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3072
    "
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3073
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3074
    "Created: / 06-03-2012 / 15:32:28 / cg"
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3075
!
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3076
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3077
disableBreakPoint:someKey
14046
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3078
    "disable parametrized breakPoints with someKey as parameter"
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3079
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3080
    "{ Pragma: +optSpace }"
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3081
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3082
    EnabledBreakPoints notNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3083
	EnabledBreakPoints remove:someKey ifAbsent:[].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3084
	EnabledBreakPoints := EnabledBreakPoints asNilIfEmpty.
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3085
    ].
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3086
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3087
    "
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3088
     nil enableBreakPoint:#cg.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3089
     nil breakPoint:#cg.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3090
     nil disableBreakPoint:#cg
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3091
     nil breakPoint:#cg.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3092
    "
14046
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3093
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3094
    "Modified (comment): / 06-03-2012 / 15:31:51 / cg"
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3095
!
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3096
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3097
enableBreakPoint:someKey
14046
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3098
    "enable parametrized breakPoints with someKey as parameter"
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3099
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3100
    "{ Pragma: +optSpace }"
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3101
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3102
    EnabledBreakPoints isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3103
	EnabledBreakPoints := Set new.
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3104
    ].
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3105
    EnabledBreakPoints add:someKey.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3106
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3107
    "
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3108
     nil enableBreakPoint:#cg.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3109
     nil breakPoint:#cg.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3110
     nil disableBreakPoint:#cg
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3111
     nil breakPoint:#cg.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3112
    "
14046
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3113
541f46216cb4 added: #disableAllBreakPoints
Claus Gittinger <cg@exept.de>
parents: 13990
diff changeset
  3114
    "Modified (comment): / 06-03-2012 / 15:31:47 / cg"
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3115
!
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3116
11048
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3117
halt
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3118
    "{ Pragma: +optSpace }"
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3119
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3120
    "enter debugger with halt-message.
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3121
     The error is reported by raising the HaltSignal exception."
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3122
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3123
    <resource: #skipInDebuggersWalkBack>
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3124
13136
e7d331537665 changed:
Claus Gittinger <cg@exept.de>
parents: 13099
diff changeset
  3125
    Smalltalk ignoreHalt ifTrue:[^ self].
14830
ac68533e9c43 class: Object
Claus Gittinger <cg@exept.de>
parents: 14778
diff changeset
  3126
    "/ don't send #halt: here - ask cg why.
14974
2f05d233c309 class: Object
Stefan Vogel <sv@exept.de>
parents: 14965
diff changeset
  3127
    HaltInterrupt raiseRequestWith:#halt.
2f05d233c309 class: Object
Stefan Vogel <sv@exept.de>
parents: 14965
diff changeset
  3128
    ^ self
2f05d233c309 class: Object
Stefan Vogel <sv@exept.de>
parents: 14965
diff changeset
  3129
2f05d233c309 class: Object
Stefan Vogel <sv@exept.de>
parents: 14965
diff changeset
  3130
    "
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3131
	(3 halt * 5)
14974
2f05d233c309 class: Object
Stefan Vogel <sv@exept.de>
parents: 14965
diff changeset
  3132
    "
11048
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3133
13136
e7d331537665 changed:
Claus Gittinger <cg@exept.de>
parents: 13099
diff changeset
  3134
    "Modified: / 02-08-1999 / 17:00:29 / stefan"
e7d331537665 changed:
Claus Gittinger <cg@exept.de>
parents: 13099
diff changeset
  3135
    "Modified: / 18-11-2010 / 11:21:51 / cg"
11048
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3136
!
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3137
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3138
halt:aString
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3139
    "{ Pragma: +optSpace }"
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3140
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3141
    "enter debugger with halt-message.
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3142
     The error is reported by raising the HaltSignal exception."
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3143
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3144
    <resource: #skipInDebuggersWalkBack>
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3145
13136
e7d331537665 changed:
Claus Gittinger <cg@exept.de>
parents: 13099
diff changeset
  3146
    Smalltalk ignoreHalt ifTrue:[^ self].
14974
2f05d233c309 class: Object
Stefan Vogel <sv@exept.de>
parents: 14965
diff changeset
  3147
    HaltInterrupt raiseRequestWith:#halt: errorString:aString.
2f05d233c309 class: Object
Stefan Vogel <sv@exept.de>
parents: 14965
diff changeset
  3148
    ^ self
11048
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3149
13136
e7d331537665 changed:
Claus Gittinger <cg@exept.de>
parents: 13099
diff changeset
  3150
    "Modified: / 18-11-2010 / 11:22:16 / cg"
11048
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3151
!
feed33f1f796 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11045
diff changeset
  3152
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3153
isBreakPointEnabled:someKey
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3154
    "{ Pragma: +optSpace }"
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3155
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3156
    "controls which breakpoints to be enabled."
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3157
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3158
"/    something = OperatingSystem getLoginName ifTrue:[^ true].
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3159
"/    something = 'testThis' ifTrue:[^ true].
11044
fa13d9423e71 allow for encounteredBreakPoints to be monitored
Claus Gittinger <cg@exept.de>
parents: 11025
diff changeset
  3160
    EncounteredBreakPoints notNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3161
	EncounteredBreakPoints add:someKey
11335
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  3162
    ].
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  3163
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  3164
    ^ (EnabledBreakPoints notNil and:[ EnabledBreakPoints includes:someKey ])
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3165
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3166
    "
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3167
     nil enableBreakPoint:#cg.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3168
     nil breakPoint:#cg.
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3169
     nil disableBreakPoint:#cg
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3170
     nil breakPoint:#cg.
11045
85315d8893e4 allow for encounteredBreakPoints to be monitored
Claus Gittinger <cg@exept.de>
parents: 11044
diff changeset
  3171
85315d8893e4 allow for encounteredBreakPoints to be monitored
Claus Gittinger <cg@exept.de>
parents: 11044
diff changeset
  3172
     EncounteredBreakPoints := Set new.
11025
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3173
    "
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3174
!
f99538ebf2a3 breakpoints improved
Claus Gittinger <cg@exept.de>
parents: 11021
diff changeset
  3175
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3176
mustBeBoolean
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3177
    "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
  3178
     in an if* or while* message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3179
     Caveat: for now, this is only sent by the interpreter;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3180
     both the JIT and the stc compiler treat it as undefined."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3181
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  3182
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  3183
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3184
    self error:'Non boolean receiver - proceed for truth' mayProceed:true.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3185
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3186
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3187
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3188
mustBeKindOf:aClass
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3189
    "for compatibility & debugging support:
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3190
     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
  3191
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3192
	it is VERY questionable, if it makes sense to add manual
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3193
	type checks to a dynamically typed language like smalltalk.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3194
	It will, at least, slow down performance,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3195
	make your code less reusable and clutter your code with stupid sends
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3196
	of this selector. Also, read the comment in isKindOf:, regarding the
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3197
	use of isXXX check methods.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3198
     You see: The author does not like this at all ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3199
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  3200
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  3201
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3202
    (self isKindOf:aClass) ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3203
	self error:'argument is not of expected type'
5755
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3206
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3207
obsoleteFeatureWarning
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3208
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3209
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3210
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3211
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3212
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3213
     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
  3214
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3215
    self obsoleteFeatureWarning:nil from:thisContext sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3216
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3217
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3218
obsoleteFeatureWarning:message
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3219
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3220
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3221
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3222
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3223
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3224
     Hopefully, this warning message is annoying enough for you to change the code... ;-).
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3225
     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
  3226
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3227
    self obsoleteFeatureWarning:message from:thisContext sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3228
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3229
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3230
obsoleteFeatureWarning:message from:aContext
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3231
    "{ Pragma: +optSpace }"
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3232
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3233
    "in methods which are going to be changed, a send to
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3234
     this method is used to tell programmers that some feature/semantics is
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3235
     used which is going to be changed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3236
     Hopefully, this warning message is annoying enough for you to change the code... ;-).
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3237
     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
  3238
11527
d8f1c75ee4d2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11401
diff changeset
  3239
    |spec sender|
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3240
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3241
    spec := aContext methodPrintString.
11527
d8f1c75ee4d2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11401
diff changeset
  3242
    sender := aContext sender.
d8f1c75ee4d2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11401
diff changeset
  3243
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3244
    ('WARNING: the ''' , spec , ''' semantics will be changed.') infoPrintCR.
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3245
    ('         Its behavior may be different in future ST/X versions.') infoPrintCR.
11527
d8f1c75ee4d2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11401
diff changeset
  3246
    ('         called from ' , sender printString) infoPrintCR.
d8f1c75ee4d2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11401
diff changeset
  3247
    ((sender selector ? '') startsWith:'perform:') ifTrue:[
d8f1c75ee4d2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11401
diff changeset
  3248
    ('         called from ' , sender sender printString) infoPrintCR.
7204
e968d9923408 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 7202
diff changeset
  3249
    ].
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3250
    message notNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3251
	'------>  ' infoPrint. message infoPrintCR
6950
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3252
    ]
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3253
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3254
    "
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3255
     Object obsoleteFeatureWarning:'foo' from:thisContext sender sender
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3256
    "
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3257
!
a59ced87dbbf +obsoleteFeatureWarning
Claus Gittinger <cg@exept.de>
parents: 6949
diff changeset
  3258
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3259
obsoleteMethodWarning
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3260
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3261
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3262
    "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
  3263
     this method is used to tell programmers that a method is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3264
     used which is going to be removed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3265
     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
  3266
     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
  3267
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3268
    self obsoleteMethodWarning:nil from:thisContext sender
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3269
!
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
obsoleteMethodWarning:message
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3272
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3273
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3274
    "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
  3275
     this method is used to tell programmers that a method is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3276
     used which is going to be removed in later ST/X versions.
6963
711b3bf3b38a comments
Claus Gittinger <cg@exept.de>
parents: 6962
diff changeset
  3277
     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
  3278
     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
  3279
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3280
    self obsoleteMethodWarning:message from:thisContext sender
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3281
!
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3282
16470
94bfe026a2cc class: Object
Claus Gittinger <cg@exept.de>
parents: 16408
diff changeset
  3283
obsoleteMethodWarning:messageOrNil from:aContext
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3284
    "{ Pragma: +optSpace }"
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3285
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3286
    "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
  3287
     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
  3288
     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
  3289
     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
  3290
     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
  3291
     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
  3292
16470
94bfe026a2cc class: Object
Claus Gittinger <cg@exept.de>
parents: 16408
diff changeset
  3293
    |spec sender message|
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3294
9509
bfb55a08130d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9442
diff changeset
  3295
    Smalltalk isSmalltalkDevelopmentSystem ifFalse:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3296
	"ignore in production systems"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3297
	^ self.
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3298
    ].
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3299
16470
94bfe026a2cc class: Object
Claus Gittinger <cg@exept.de>
parents: 16408
diff changeset
  3300
    message := messageOrNil ? 'Obsolete method called'.
94bfe026a2cc class: Object
Claus Gittinger <cg@exept.de>
parents: 16408
diff changeset
  3301
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3302
    spec := aContext methodPrintString.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3303
    sender := aContext sender.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3304
    ('WARNING: the ''' , spec , ''' method is obsolete.') infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3305
    ('         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
  3306
    ('         called from ' , sender printString) infoPrintCR.
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3307
    (sender selector startsWith:'perform:') ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3308
	sender := sender sender.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3309
	(sender selector startsWith:'perform:') ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3310
	    sender := sender sender.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3311
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3312
	('         called from ' , sender printString) infoPrintCR.
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3313
    ].
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3314
    message notNil ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3315
	'------>  ' infoPrint. message infoPrintCR
16383
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  3316
    ].
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  3317
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  3318
    "CG: care for standalone non-GUI progs, which have no userPreferences class"
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  3319
    (Smalltalk isInitialized
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  3320
    and:[ UserPreferences notNil
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  3321
    and:[ UserPreferences current haltInObsoleteMethod]]) ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3322
	"/ cg: nice try, stefan, but I don't want halts in system processes (fly by help and others)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3323
	Processor activeProcess isSystemProcess ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3324
	    (message , ' - please fix this now (no halt in system process)') infoPrintCR
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3325
	] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3326
	    "/ please check for the sender of the obsoleteMethodWarning,
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3327
	    "/ and fix the code there.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3328
	    self halt:(message , ' - please fix this now!!')
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  3329
	].
15716
72e323fea23f class: Object
Claus Gittinger <cg@exept.de>
parents: 15683
diff changeset
  3330
    ].
8829
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3331
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3332
    "
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3333
     Object obsoleteMethodWarning:'foo' from:thisContext sender sender
9e640b6c0679 No obsolete messages in standalone apps
Stefan Vogel <sv@exept.de>
parents: 8827
diff changeset
  3334
    "
9509
bfb55a08130d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9442
diff changeset
  3335
bfb55a08130d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9442
diff changeset
  3336
    "Modified: / 10-08-2006 / 13:13:11 / cg"
10558
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3337
!
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3338
12341
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3339
todo
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3340
    "used to mark code pieces that have to be implemented"
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3341
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3342
    <resource: #skipInDebuggersWalkBack>
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3343
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3344
    self halt:'more work needed here'.
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3345
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3346
    "
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3347
     example:
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3348
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3349
	...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3350
	self todo.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3351
	...
12341
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3352
    "
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3353
!
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3354
10558
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3355
todo:aBlock
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3356
    "used to mark code pieces that have to be implemented"
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3357
12341
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3358
    <resource: #skipInDebuggersWalkBack>
47a2bade1cbd added: #todo
Claus Gittinger <cg@exept.de>
parents: 12340
diff changeset
  3359
10558
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3360
"/    self halt.
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3361
"/    aBlock value.
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3362
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3363
    "
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3364
     example:
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3365
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3366
	...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3367
	self todo:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3368
	    code which needs more work ...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3369
	].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3370
	...
10558
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3371
    "
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3372
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3373
    "Created: / 25-05-2007 / 21:34:39 / cg"
Claus Gittinger <cg@exept.de>
parents: 10539
diff changeset
  3374
    "Modified: / 29-05-2007 / 12:11:33 / cg"
15683
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3375
!
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3376
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3377
tracePoint:someKey
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3378
    "{ Pragma: +optSpace }"
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3379
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3380
    "Like transcript show, but disabled by default.
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3381
     Can be easily enabled.
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3382
     Can be filtered on the arguments value (typically: a symbol).
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3383
     Code with tracepoints may be even checked into the source repository"
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3384
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3385
    "Example:   nil tracePoint:#stefan"
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3386
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3387
    (self isBreakPointEnabled:someKey) ifTrue:[
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3388
	^ Transcript showCR:('Tracepoint (at %1 for %3 from %2)'
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3389
				bindWith:(Timestamp now printString)
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3390
				with:(thisContext sender printString)
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3391
				with:someKey)
15683
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3392
    ].
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3393
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3394
    "
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3395
     nil tracePoint:#stefan
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3396
     nil tracePoint:#stefan message:'Hello'
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3397
     Smalltalk enableBreakPoint:#stefan.
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3398
     Smalltalk disableBreakPoint:#stefan.
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3399
    "
15723
2997392ee626 class: Object
Claus Gittinger <cg@exept.de>
parents: 15716
diff changeset
  3400
2997392ee626 class: Object
Claus Gittinger <cg@exept.de>
parents: 15716
diff changeset
  3401
    "Modified: / 28-08-2013 / 21:41:54 / cg"
15683
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3402
!
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3403
15804
cc01a011076e class: Object
Stefan Vogel <sv@exept.de>
parents: 15797
diff changeset
  3404
tracePoint:someKey message:messageBlockOrString
15683
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3405
    "{ Pragma: +optSpace }"
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3406
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3407
    "Like transcript show, but disabled by default.
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3408
     Can be easily enabled.
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3409
     Can be filtered on the arguments value (typically: a symbol).
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3410
     Code with tracepoints may be even checked into the source repository"
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3411
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3412
    "Example:   nil tracePoint:#stefan"
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3413
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3414
    (self isBreakPointEnabled:someKey) ifTrue:[
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3415
	Transcript showCR:('Tracepoint: %4 (at %1 for %3 from %2)'
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3416
				bindWith:(Timestamp now printString)
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3417
				with:(thisContext sender printString)
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3418
				with:someKey
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3419
				with:messageBlockOrString value)
15804
cc01a011076e class: Object
Stefan Vogel <sv@exept.de>
parents: 15797
diff changeset
  3420
    ].
cc01a011076e class: Object
Stefan Vogel <sv@exept.de>
parents: 15797
diff changeset
  3421
cc01a011076e class: Object
Stefan Vogel <sv@exept.de>
parents: 15797
diff changeset
  3422
    "
15683
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3423
     Smalltalk enableBreakPoint:#stefan.
15804
cc01a011076e class: Object
Stefan Vogel <sv@exept.de>
parents: 15797
diff changeset
  3424
     nil tracePoint:#stefan.
cc01a011076e class: Object
Stefan Vogel <sv@exept.de>
parents: 15797
diff changeset
  3425
     nil tracePoint:#stefan message:'Hello'.
cc01a011076e class: Object
Stefan Vogel <sv@exept.de>
parents: 15797
diff changeset
  3426
     nil tracePoint:#stefan message:['Hello from block'].
15683
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3427
     Smalltalk disableBreakPoint:#stefan.
d72a36fe05b0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15645
diff changeset
  3428
    "
15723
2997392ee626 class: Object
Claus Gittinger <cg@exept.de>
parents: 15716
diff changeset
  3429
2997392ee626 class: Object
Claus Gittinger <cg@exept.de>
parents: 15716
diff changeset
  3430
    "Modified: / 28-08-2013 / 21:41:47 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3431
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3432
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3433
!Object methodsFor:'dependents access'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3434
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3435
addDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3436
    "make the argument, anObject be a dependent of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3437
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3438
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3439
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3440
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3441
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3442
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3443
    "/ faster execution.
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
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3446
    [
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3447
	|deps dep|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3448
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3449
	deps := self dependents.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3450
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3451
	"/ to save a fair amount of memory in case of
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3452
	"/ many dependencies, we store a single dependent in
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3453
	"/ a WeakArray, and switch to a WeakSet if more dependents are
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3454
	"/ added.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3455
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3456
	(deps isNil or:[deps size == 0]) ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3457
	    self dependents:(WeakArray with:anObject)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3458
	] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3459
	    deps class == WeakArray ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3460
		dep := deps at:1.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3461
		dep ~~ anObject ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  3462
		    (dep isNil or:[dep class == SmallInteger]) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3463
			deps at:1 put:anObject
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3464
		    ] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3465
			self dependents:(WeakIdentitySet with:dep with:anObject)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3466
		    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3467
		]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3468
	    ] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3469
		deps add:anObject
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3470
	    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3471
	]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3472
    ] ensure:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3473
	wasBlocked ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3474
	    OperatingSystem unblockInterrupts
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3475
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3476
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3477
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3478
    "Modified: / 27.10.1997 / 19:35:52 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3479
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3480
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3481
breakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3482
    "remove all dependencies from the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3483
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3484
    self dependents:nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3485
    self nonWeakDependents:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3486
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3487
    "Modified: / 19.4.1996 / 10:55:36 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3488
    "Created: / 27.2.1998 / 11:26:11 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3489
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3490
8542
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3491
breakDependentsRecursively
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3492
    "remove all dependencies from the receiver and
8542
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3493
     recursively from all objects referred to by the receiver."
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3494
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3495
    self breakDependents.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3496
    1 to:self class instSize do:[:idx |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3497
	(self instVarAt:idx) breakDependentsRecursively.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3498
    ].
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3499
    1 to:self basicSize do:[:idx |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3500
	(self basicAt:idx) breakDependentsRecursively.
8542
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3501
    ]
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3502
!
38f9d04fe40a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8521
diff changeset
  3503
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3504
dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3505
    "return a Collection of dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3506
     The default implementation here uses a global WeakDictionary to store
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3507
     dependents
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3508
     This may be too slow for high frequency change&update,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3509
     therefore, some classes (Model) redefine this for better performance.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3510
     Notice the mentioning of a WeakDictionary - read the classes documentation."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3511
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3512
    |deps|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3513
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3514
    (deps := Dependencies at:self ifAbsent:nil) isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3515
	^ #().
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3516
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3517
    ^ deps
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3518
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3519
    "Modified: / 26.1.1998 / 11:18:15 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3520
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3521
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3522
dependents:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3523
    "set the collection of dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3524
     The default implementation here uses a global Dictionary to store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3525
     dependents which may be too slow for high frequency change&update.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3526
     Therefore, some classes (Model) redefine this for better performance."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3527
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3528
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3529
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3530
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3531
    "/ faster execution (and to avoid creation of garbage blocks).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3532
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3533
    (OperatingSystem blockInterrupts) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3534
	"/ the common case - already blocked
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3535
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3536
	(aCollection isNil or:[aCollection isEmpty]) ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3537
	    Dependencies removeKey:self ifAbsent:nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3538
	] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3539
	    Dependencies at:self put:aCollection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3540
	].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3541
	^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3542
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3543
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3544
    [
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3545
	(aCollection isNil or:[aCollection isEmpty]) ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3546
	    Dependencies removeKey:self ifAbsent:nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3547
	] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3548
	    Dependencies at:self put:aCollection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3549
	].
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3550
    ] ensure:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3551
	OperatingSystem unblockInterrupts
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3552
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3553
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3554
    "Modified: 30.1.1997 / 21:22:10 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3555
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3556
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3557
dependentsDo:aBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3558
    "evaluate aBlock for all of my dependents"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3559
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3560
    |deps nwDeps|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3561
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3562
    deps := self dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3563
    deps size ~~ 0 ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3564
	deps do:[:d |
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  3565
		    (d notNil and:[d class ~~ SmallInteger]) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3566
			aBlock value:d
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3567
		    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3568
		]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3569
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3570
    nwDeps := self nonWeakDependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3571
    (nwDeps ~~ deps and:[nwDeps size ~~ 0]) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3572
	nwDeps do:aBlock
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3573
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3574
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3575
    "Modified: / 30.1.1998 / 14:03:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3576
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3577
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3578
myDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3579
    "same as dependents - ST-80 compatibility"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3580
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3581
    ^ self dependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3582
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3583
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3584
release
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3585
    "remove all references to objects that may refer to self.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3586
     Subclasses may redefine this method but should do a 'super release'."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3587
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3588
    self breakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3589
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3590
    "Modified: / 27.2.1998 / 11:29:35 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3591
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3592
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3593
removeDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3594
    "make the argument, anObject be independent of the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3595
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3596
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3597
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3598
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3599
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3600
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3601
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3602
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3603
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3604
    [
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3605
	|deps n d|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3606
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3607
	deps := self dependents.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3608
	deps size ~~ 0 ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3609
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3610
	    "/ to save a fair amount of memory in case of
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3611
	    "/ many dependencies, we store a single dependent in
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3612
	    "/ a WeakArray, and switch to a WeakSet if more dependents are
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3613
	    "/ added. Here we have to do the inverse ...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3614
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3615
	    ((deps class == WeakArray) or:[deps class == Array]) ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3616
		((d := deps at:1) == anObject
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3617
		or:[d isNil
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  3618
		or:[d class == SmallInteger]]) ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3619
		    self dependents:nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3620
		]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3621
	    ] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3622
		deps remove:anObject ifAbsent:[].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3623
		(n := deps size) == 0 ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3624
		    self dependents:nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3625
		] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3626
		    n == 1 ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3627
			d := deps firstIfEmpty:nil.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3628
			d notNil ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3629
			    deps := (deps isWeakCollection ifTrue:[WeakArray] ifFalse:[Array]) with:d
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3630
			] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3631
			    deps := nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3632
			].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3633
			self dependents:deps.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3634
		    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3635
		]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3636
	    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3637
	]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3638
    ] ensure:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3639
	wasBlocked ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3640
	    OperatingSystem unblockInterrupts
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3641
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3642
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3643
13500
51b2e6c6c2ac changed:
Claus Gittinger <cg@exept.de>
parents: 13488
diff changeset
  3644
    "Modified: / 05-07-2011 / 22:49:31 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3645
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3646
7266
f2b64d3b43cf method category rename
Claus Gittinger <cg@exept.de>
parents: 7261
diff changeset
  3647
!Object methodsFor:'dependents access (non weak)'!
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3648
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3649
addNonWeakDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3650
    "make the argument, anObject be a nonWeak dependent of the receiver.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3651
     Be careful: this nonWeakDependency will prevent the dependent from being
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3652
     garbage collected unless the dependency is removed.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3653
     This is a private mechanism, for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3654
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3655
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3656
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3657
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3658
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3659
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3660
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3661
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3662
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3663
    [
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3664
	|deps dep|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3665
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3666
	deps := self nonWeakDependents.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3667
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3668
	"/ to save a fair amount of memory in case of
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3669
	"/ many dependencies, we store a single dependent in
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3670
	"/ an Array, and switch to a Set if more dependents are
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3671
	"/ added.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3672
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3673
	deps size == 0 ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3674
	    anObject notNil ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3675
		self nonWeakDependents:(Array with:anObject).
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3676
	    ] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3677
		"adding nil causes problems when adding the next one
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3678
		 (see below: trying to add nil to IdentitySet)"
9442
f564054eaf6a do not add nil as dependent
Stefan Vogel <sv@exept.de>
parents: 9405
diff changeset
  3679
"/                self halt:'try to add nil to list of dependents'.
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3680
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3681
	] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3682
	    deps class == Array ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3683
		dep := deps at:1.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3684
		dep ~~ anObject ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3685
		    self nonWeakDependents:(IdentitySet with:dep with:anObject)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3686
		]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3687
	    ] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3688
		deps add:anObject
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3689
	    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3690
	]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3691
    ] ensure:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3692
	wasBlocked ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3693
	    OperatingSystem unblockInterrupts
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3694
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3695
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3696
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3697
    "Created: / 19.4.1996 / 10:54:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3698
    "Modified: / 30.1.1998 / 14:03:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3699
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3700
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3701
nonWeakDependents
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3702
    "return a Collection of nonWeakDependents - empty if there is none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3703
     This is a private mechanism for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3704
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3705
    NonWeakDependencies isNil ifTrue:[^ #()].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3706
    ^ NonWeakDependencies at:self ifAbsent:#()
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3708
    "Created: / 19.4.1996 / 10:55:06 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3709
    "Modified: / 30.1.1998 / 14:06:47 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3710
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3711
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3712
nonWeakDependents:aCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3713
    "set the collection of nonWeak dependents.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3714
     This is a private helper for directed dependencies."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3715
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3716
    [
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3717
	(aCollection isNil or:[aCollection isEmpty]) ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3718
	    NonWeakDependencies removeKey:self ifAbsent:nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3719
	] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3720
	    NonWeakDependencies at:self put:aCollection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3721
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3722
    ] valueUninterruptably
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3723
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3724
    "Created: 19.4.1996 / 11:07:47 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3725
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3726
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3727
removeNonWeakDependent:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3728
    "remove a nonWeak dependency from the receiver to the argument, anObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3729
     (i.e. make it independent of the receiver)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3730
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3731
    |wasBlocked|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3732
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3733
    "/ must do this save from interrupts, since the dependents collection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3734
    "/ is possibly accessed from multiple threads.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3735
    "/ Used to use #valueUninterruptably here; inlined that code for slightly
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3736
    "/ faster execution.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3737
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3738
    wasBlocked := OperatingSystem blockInterrupts.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3739
    [
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3740
	|deps n|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3741
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3742
	deps := self nonWeakDependents.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3743
	deps size ~~ 0 ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3744
	    deps class == Array ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3745
		(deps at:1) == anObject ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3746
		    self nonWeakDependents:nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3747
		]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3748
	    ] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3749
		deps remove:anObject ifAbsent:[].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3750
		(n := deps size) == 0 ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3751
		    self nonWeakDependents:nil
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3752
		] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3753
		    n == 1 ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3754
			self nonWeakDependents:(Array with:(deps first))
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3755
		    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3756
		]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3757
	    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3758
	]
6421
58dca33cf0fc #valueNowOrOnUnwindDo: -> #ensure:
Claus Gittinger <cg@exept.de>
parents: 6418
diff changeset
  3759
    ] ensure:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3760
	wasBlocked ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3761
	    OperatingSystem unblockInterrupts
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3762
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3763
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3764
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3765
    "Created: / 19.4.1996 / 11:44:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3766
    "Modified: / 30.1.1998 / 14:04:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3767
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3768
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3769
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  3770
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3771
!Object methodsFor:'displaying'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3772
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3773
ascentOn:aGC
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3774
    "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
  3775
     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
  3776
     coordinate is given by y.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3777
     In other words: some draw above the given y coordinate.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3778
     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
  3779
     the given y coordinate."
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3780
11065
17c01b01000f Simplify (and speed up) #ascentOn:
Stefan Vogel <sv@exept.de>
parents: 11048
diff changeset
  3781
    ^ aGC fontAscent
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3782
!
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3783
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3784
displayOn:aGCOrStream
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3785
    "Compatibility
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3786
     append a printed desription on some stream (Dolphin,  Squeak)
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3787
     OR:
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3788
     display the receiver in a graphicsContext at 0@0 (ST80).
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3789
     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
  3790
     (although the fallBack is to display its printString ...)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3791
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3792
    "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3793
    "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
14292
1cbc2d35aa17 Implement #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents: 14272
diff changeset
  3794
    aGCOrStream isStream ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3795
	self printOn:aGCOrStream.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3796
	^ self
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3797
    ].
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  3798
    ^ self displayOn:aGCOrStream x:0 y:0.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3799
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3800
    "Created: 29.5.1996 / 16:28:58 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3801
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3802
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3803
displayOn:aGC at:aPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3804
    "ST-80 Compatibility
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3805
     display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3806
     for any object to be displayed in a ListView - for example."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3807
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3808
    ^ self displayOn:aGC x:(aPoint x) y:(aPoint y).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3809
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3810
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3811
displayOn:aGC x:x y:y
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3812
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3813
     for any object to be displayed in a ListView - for example."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3814
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3815
    self displayOn:aGC x:x y:y opaque:false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3816
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3817
    "Modified: 29.5.1996 / 16:29:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3818
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3819
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3820
displayOn:aGc x:x y:y opaque:opaque
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3821
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3822
     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
  3823
     The fallBack here shows the receivers displayString.
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3824
     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
  3825
     ask using #ascentOn: if required"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3826
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3827
    |s yBaseline|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3828
15368
1509922b75ec class: Object
Claus Gittinger <cg@exept.de>
parents: 15362
diff changeset
  3829
    s := self isString ifTrue:[self] ifFalse:[self displayString].
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  3830
    yBaseline := y "+ aGc font ascent".
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3831
    opaque ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3832
	aGc displayOpaqueString:s x:x y:yBaseline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3833
    ] ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  3834
	aGc displayString:s x:x y:yBaseline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3835
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3836
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3837
    "Modified: 29.5.1996 / 16:29:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3838
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3839
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3840
displayOpaqueOn:aGC x:x y:y
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3841
    "display the receiver in a graphicsContext - this method allows
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3842
     for any object to be displayed in a ListView - for example."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3843
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3844
    self displayOn:aGC x:x y:y opaque:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3845
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3846
    "Modified: / 29.5.1996 / 16:29:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3847
    "Created: / 26.10.1997 / 15:01:36 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3848
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3849
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3850
displayString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3851
    "return a string used when displaying the receiver in a view;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3852
     for example an Inspector. This is usually the same as printString,
14292
1cbc2d35aa17 Implement #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents: 14272
diff changeset
  3853
     but sometimes redefined for a better look.
1cbc2d35aa17 Implement #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents: 14272
diff changeset
  3854
1cbc2d35aa17 Implement #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents: 14272
diff changeset
  3855
     Note: the base method (used by the inspector) is #displayOn:.
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3856
	   So you should implement #displayOn: instead of #displayString in subclasses."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3857
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3858
    |s|
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3859
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  3860
    "/ attention: TextStream is not present in ultra-mini standalone apps
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3861
    s := TextStream isNil
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3862
	    ifTrue:['' writeStream]
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  3863
	    ifFalse:[TextStream on:(String new:32)].
7081
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3864
    self displayOn:s.
4e1ae4a0b3c1 added ascentOn: (display-ascent);
Claus Gittinger <cg@exept.de>
parents: 7048
diff changeset
  3865
    ^ s contents
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3866
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3867
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3868
     #(1 2 3) printString
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  3869
     #(1 2 3) displayString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3870
     #(1 2 3) storeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3871
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3872
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3873
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3874
heightOn:aGC
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3875
    "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
  3876
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3877
    ^ (aGC font onDevice:aGC device) heightOf:(self displayString)
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
16010
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3880
printStringForPrintIt
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3881
    "for compatibility (used to be displayString), now the printIt menu function now sends this message"
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3882
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3883
    ^ self displayString
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3884
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3885
    "
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3886
     #(1 2 3) printString
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3887
     #(1 2 3) printStringForPrintIt
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3888
     #(1 2 3) storeString
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3889
    "
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3890
!
6bb36b8b4f4a class: Object
Claus Gittinger <cg@exept.de>
parents: 15943
diff changeset
  3891
6654
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3892
widthFrom:startIndex to:endIndex on:aGC
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3893
    "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
  3894
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3895
    ^ (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
  3896
!
a760031ee530 +widthFrom:to:on:
Michael Beyl <mb@exept.de>
parents: 6652
diff changeset
  3897
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3898
widthOn:aGC
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3899
    "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
  3900
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3901
    ^ (aGC font onDevice:aGC device) widthOf:(self displayString)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3902
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3903
7359
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3904
!Object methodsFor:'double dispatching'!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3905
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3906
equalFromComplex:aComplex
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3907
    "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
  3908
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3909
     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
  3910
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3911
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3912
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3913
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3914
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3915
equalFromFixedPoint:aFixedPoint
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3916
    "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
  3917
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3918
     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
  3919
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3920
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3921
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3922
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3923
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3924
equalFromFloat:aFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3925
    "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
  3926
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3927
     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
  3928
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3929
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3930
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3931
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3932
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3933
equalFromFraction:aFraction
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3934
    "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
  3935
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3936
     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
  3937
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3938
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3939
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3940
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3941
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3942
equalFromInteger:anInteger
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3943
    "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
  3944
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3945
     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
  3946
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3947
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3948
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3949
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3950
7455
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3951
equalFromLargeFloat:aLargeFloat
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3952
    "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
  3953
     and return false from this comparison.
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3954
     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
  3955
     which uses #= (i.e. a Set or Dictionary)."
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3956
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3957
    ^ false
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3958
!
6abc135763f6 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7402
diff changeset
  3959
7359
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3960
equalFromLongFloat:aLongFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3961
    "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
  3962
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3963
     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
  3964
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3965
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3966
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3967
!
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3968
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3969
equalFromShortFloat:aShortFloat
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3970
    "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
  3971
     and return false from this comparison.
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3972
     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
  3973
     which uses #= (i.e. a Set or Dictionary)."
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3974
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3975
    ^ false
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3976
! !
67d55d0086fb storing short floats fixed
Claus Gittinger <cg@exept.de>
parents: 7345
diff changeset
  3977
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3978
!Object methodsFor:'encoding & decoding'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3979
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3980
decodeAsLiteralArray
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3981
    "given a literalEncoding in the receiver,
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3982
     create & return the corresponding object.
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3983
     The inverse operation to #literalArrayEncoding."
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  3984
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3985
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3986
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3987
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  3988
encodeOn:anEncoder with:aParameter
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3989
    "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
  3990
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3991
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3992
8404
c0bd2a56dc3b *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 8397
diff changeset
  3993
    self acceptVisitor:anEncoder with:aParameter
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3994
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3995
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  3996
encodingVectorForInstanceVariables
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3997
    "OBSOLETE, use elementDescriptorForInstanceVariables"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3998
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  3999
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4000
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4001
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | true].
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4002
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4003
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4004
      #(1 2 3 nil true symbol) encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4005
      Dictionary new encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4006
      (5 @ nil) encodingVectorForInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4007
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4008
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4009
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4010
encodingVectorForNonNilInstanceVariables
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4011
    "OBSOLETE, use elementDescriptorForNonNilInstanceVariables"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4012
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4013
    <resource: #obsolete>
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4014
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4015
    ^ self elementDescriptorForInstanceVariablesMatching:[:varVal | varVal notNil].
6718
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4016
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4017
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4018
      #(1 2 3 nil true symbol) encodingVectorForNonNilInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4019
      (5 @ nil) encodingVectorForNonNilInstanceVariables
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4020
    "
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4021
!
6d91ccd79d53 Encoding stuff
Stefan Vogel <sv@exept.de>
parents: 6716
diff changeset
  4022
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4023
fromLiteralArrayEncoding:aSpecArray
8798
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4024
    "read my attributes from aSpecArray.
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4025
     Recursively decodes arguments."
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4026
73676c762813 comment
Claus Gittinger <cg@exept.de>
parents: 8789
diff changeset
  4027
    |sel litVal val
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4028
     stop   "{ Class:SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4029
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4030
    stop := aSpecArray size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4031
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4032
    2 to:stop by:2 do:[:i|
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4033
	sel := aSpecArray at:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4034
	litVal := aSpecArray at:i + 1.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4035
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4036
	(self respondsTo:sel) ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4037
	    val := litVal decodeAsLiteralArray.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4038
	    self perform:sel with:val
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4039
	] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4040
	    Transcript show:self class name; show:': unhandled literalArrayEncoding attribute: '.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4041
	    Transcript showCR:sel.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4042
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4043
	    "/ thats a debug halt,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4044
	    "/ it should probably be removed (to simply ignore unhandled attributes)...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4045
	    "/ for now, it is left in, in order to easily find incompatibilities between
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4046
	    "/ VW and ST/X.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4047
	    self breakPoint:#cg.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4048
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4049
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4050
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4051
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4052
literalArrayEncoding
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4053
    "generate a literalArrayEncoding array for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4054
     This uses #literalArrayEncodingSlotOrder which defines the slots and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4055
     order and #skippedInLiteralEncoding which defines slots to skip.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4056
     For most subclasses, there is no need to redefine those."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4057
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4058
    |names encoding cls skipped slots|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4059
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4060
    self isLiteral ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4061
	^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4062
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4063
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4064
    slots    := self literalArrayEncodingSlotOrder.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4065
    skipped  := self skippedInLiteralEncoding.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4066
    cls      := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4067
    names    := cls allInstVarNames.
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4068
    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
  4069
    encoding add:cls name.
8832
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4070
8210e23f6c32 Speed up #literalArrayEncoding
Stefan Vogel <sv@exept.de>
parents: 8829
diff changeset
  4071
    slots do:[:instSlot |
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4072
	|value nm|
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4073
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4074
	nm := names at:instSlot.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4075
	(skipped includes:nm) ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4076
	    (value := self instVarAt:instSlot) notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4077
		encoding add:(nm asMutator).
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4078
		encoding add:value literalArrayEncoding
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4079
	    ]
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4080
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4081
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4082
    ^ encoding asArray
8841
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4083
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4084
    "
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4085
	(1 -> 2) literalArrayEncoding
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4086
	DebugView menuSpec decodeAsLiteralArray literalArrayEncoding  =
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4087
	   DebugView menuSpec
8841
d5acf50ec5a6 Comment
Stefan Vogel <sv@exept.de>
parents: 8839
diff changeset
  4088
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4089
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4090
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4091
literalArrayEncodingSlotOrder
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4092
    "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
  4093
     a literalArrayEncoding"
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4094
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4095
    ^ 1 to:self class instSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4096
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4097
7112
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4098
postDecodeFrom:aDecoder aspect:aspectSymbol
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4099
    "invoked by xmlDecoder (and others in the future), after an
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4100
     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
  4101
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4102
    ^ self
7112
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4103
!
6299f5d9129c added postDecodeFrom - to allow for an object to
martin
parents: 7094
diff changeset
  4104
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4105
skippedInLiteralEncoding
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
  4106
    "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
  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
!Object methodsFor:'error handling'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4112
16012
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4113
abortOperation
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4114
    "{ Pragma: +optSpace }"
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4115
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4116
    "raise the AbortOperationRequest signal.
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4117
     This will unwind and bring the current thread back to the event-handling loop,
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4118
     effectively aborting any current menu, user, doIt, printIt or other operation."
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4119
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4120
    <resource: #skipInDebuggersWalkBack>
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4121
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4122
    ^ AbortOperationRequest raise
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4123
!
10e4d76d9a0c class: Object
Claus Gittinger <cg@exept.de>
parents: 16011
diff changeset
  4124
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4125
ambiguousMessage:aMessage
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4126
    "this message is sent by the system in case that it
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4127
     is not clear which method to execute in response to
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  4128
     aMessage.
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4129
     Such situation may occur when a current selector namespace
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4130
     imports two namespaces and both define a method with the
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4131
     requested selector."
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4132
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4133
    <context: #return>
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4134
    <resource: #skipInDebuggersWalkBack>
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4135
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4136
    ^ AmbiguousMessage raiseRequestWith:aMessage
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4137
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4138
    "Created: / 21-07-2010 / 15:44:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4139
    "Modified (comment): / 02-11-2012 / 10:14:42 / cg"
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4140
!
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  4141
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4142
cannotSendMessage:aMessage to:someReceiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4143
    "this message is sent by the runtime system (VM),
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4144
     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
  4145
     a valid behavior (see documentation in Behavior)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4146
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4147
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4148
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4149
    ^ VMInternalError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4150
	  raiseWith:someReceiver
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4151
	  errorString:('bad class in send of #' , aMessage selector)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4152
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4153
    "Modified: 23.1.1997 / 00:05:39 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4154
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4155
11132
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
  4156
conversionErrorSignal
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
  4157
    "return the signal used for conversion error handling"
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
  4158
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
  4159
    ^ self class conversionErrorSignal
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
  4160
!
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
  4161
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4162
doesNotUnderstand:aMessage
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4163
    "this message is sent by the runtime system (VM) when
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4164
     a message is not understood by some object (i.e. there
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4165
     is no method for that selector). The original message has
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4166
     been packed into aMessage (i.e. the receiver, selector and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4167
     any arguments) and the original receiver is then sent the
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4168
     #doesNotUnderstand: message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4169
     Here, we raise another signal which usually enters the debugger.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4170
     You can of course redefine #doesNotUnderstand: in your classes
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4171
     to implement message delegation,
8500
10d47cede03c Speed up MessageNotUnderstood exception sending by layz computation
Stefan Vogel <sv@exept.de>
parents: 8481
diff changeset
  4172
     or handle the MessageNotUnderstood exception gracefully."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4173
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4174
    <context: #return>
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4175
    <resource: #skipInDebuggersWalkBack>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4176
8500
10d47cede03c Speed up MessageNotUnderstood exception sending by layz computation
Stefan Vogel <sv@exept.de>
parents: 8481
diff changeset
  4177
    ^ MessageNotUnderstood raiseRequestWith:aMessage
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4180
elementBoundsError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4181
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4182
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4183
    "report an error that badElement is out of bounds
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4184
     (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
  4185
     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
  4186
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4187
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4188
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4189
    ^ ElementBoundsError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4190
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4191
    "Modified: 8.5.1996 / 09:12:45 / cg"
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
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4194
elementBoundsError:aValue
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4195
    "{ Pragma: +optSpace }"
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4196
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4197
    "report an error that aValue is not valid as element
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4198
     (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
  4199
     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
  4200
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4201
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4202
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4203
    ^ ElementBoundsError raiseWith:aValue
7215
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4204
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4205
    "Modified: 8.5.1996 / 09:12:45 / cg"
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4206
!
733294e1a8cc correct use of ascentOn: for display
Claus Gittinger <cg@exept.de>
parents: 7211
diff changeset
  4207
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4208
elementNotCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4209
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4210
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4211
    "report an error that object to be stored is no Character.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4212
     (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
  4213
     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
  4214
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4215
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4216
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4217
    ^ ElementBoundsError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4218
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4219
    "Modified: 8.5.1996 / 09:12:49 / 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
elementNotInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4223
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4224
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4225
    "report an error that object to be stored is not Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4226
     (in collections that store integers only).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4227
     The error is reported by raising the ElementOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4228
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4229
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4230
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4231
    ^ ElementBoundsError raise
5755
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
    "Modified: 8.5.1996 / 09:12:51 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4234
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4235
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4236
error
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4237
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4238
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4239
    "report error that an error occured.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4240
     The error is reported by raising the Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4241
     which is non-proceedable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4242
     If no handler has been setup, a debugger is entered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4243
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4244
    <context: #return>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4245
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4246
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4247
    Error raiseWith:#error:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4248
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
     nil error
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4251
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4252
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4253
    "Modified: / 8.5.1996 / 09:13:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4254
    "Modified: / 2.8.1999 / 17:00:19 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4255
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4256
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4257
error:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4258
    "{ Pragma: +optSpace }"
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
    "Raise an error with error message aString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4261
     The error is reported by raising the Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4262
     which is non-proceedable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4263
     If no handler has been setup, a debugger is entered."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4264
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4265
    <context: #return>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4266
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4267
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4268
    Error raiseWith:#error: errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4269
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4270
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4271
      nil error:' bad bad bad'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4272
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4273
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4274
    "Modified: 8.5.1996 / 09:13:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4275
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4276
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4277
error:aString mayProceed:mayProceed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4278
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4279
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4280
    "enter debugger with error-message aString.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4281
     The error is reported by raising either the
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4282
     non-proceedable Error exception,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4283
     or the ProceedableError exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4284
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4285
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4286
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4287
    mayProceed ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4288
	^ ProceedableError raiseRequestWith:#error: errorString:aString
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4289
    ].
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4290
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4291
    Error raiseWith:#error: errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4292
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4293
    "Modified: 8.5.1996 / 09:13:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4294
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4295
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4296
errorInvalidFormat
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4297
    "{ Pragma: +optSpace }"
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4298
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4299
    "report an error that some conversion to/from string representation failed
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4300
     typically when converting numbers, date, time etc."
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4301
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4302
    <context: #return>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4303
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4304
6900
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4305
    ^ ConversionError raiseErrorString:'invalid format'
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4306
!
3b1eafe032b2 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6884
diff changeset
  4307
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4308
errorKeyNotFound:aKey
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4309
    "{ Pragma: +optSpace }"
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
    "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
  4312
     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
  4313
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4314
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4315
10918
a4635305501e #instVarNamed* - raise KeyNotFoundError if an instaver does not exist
Stefan Vogel <sv@exept.de>
parents: 10877
diff changeset
  4316
    ^ KeyNotFoundError raiseRequestWith:aKey errorString:(' ', aKey printString)
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4317
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  4318
    "
18685
8cce79003d52 class: Object
Claus Gittinger <cg@exept.de>
parents: 18620
diff changeset
  4319
     Dictionary new at:#nonExistentElement
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4320
    "
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4323
errorNotFound
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4324
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4325
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4326
    "report an error that no element was found in a collection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4327
     The error is reported by raising the NotFoundSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4328
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4329
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4330
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4331
    ^ NotFoundError raiseRequestWith:nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4332
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4333
    "Modified: / 8.5.1996 / 09:13:11 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4334
    "Modified: / 26.7.1999 / 10:51:50 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4335
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4336
6874
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4337
errorNotFound:errorString
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4338
    "{ Pragma: +optSpace }"
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4339
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4340
    "report an error that no element was found in a collection.
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4341
     The error is reported by raising the NotFoundSignal exception."
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4342
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4343
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4344
10837
63d19c75d762 changed #errorNotFound: raise it proceedable
Stefan Vogel <sv@exept.de>
parents: 10834
diff changeset
  4345
    ^ NotFoundError raiseRequestErrorString:errorString
6874
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4346
!
c539a4c44df1 +errorNotFound:
Claus Gittinger <cg@exept.de>
parents: 6845
diff changeset
  4347
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4348
errorSignal
11132
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
  4349
    "return the signal used for error/error: handling"
e5bd3a66ca80 conversion errors (specific error classes)
Claus Gittinger <cg@exept.de>
parents: 11068
diff changeset
  4350
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4351
    ^ self class errorSignal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4352
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4353
    "Created: / 19.6.1998 / 02:32:32 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4354
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4355
7322
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4356
handlerForSignal:exceptionHandler context:theContext originator:originator
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4357
    " 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
  4358
7566
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4359
    thisContext isRecursive ifTrue:[^ nil].
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4360
7322
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4361
    '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
  4362
    '         context: ' print. theContext printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4363
    '         originator: ' print. originator printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4364
    '         sender: ' print. thisContext sender printCR.
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4365
7566
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4366
    "/ MiniDebugger enter:thisContext withMessage:'oops' mayProceed:true.
f691eac0f114 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7562
diff changeset
  4367
    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
  4368
!
178e33c2a376 catch non-block/non-signal/non-exception being
Claus Gittinger <cg@exept.de>
parents: 7320
diff changeset
  4369
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4370
implementedBySubclass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4371
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4372
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4373
    "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
  4374
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4375
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4376
12322
a8a569a96301 changed:
Claus Gittinger <cg@exept.de>
parents: 12321
diff changeset
  4377
    ^ SubclassResponsibilityError raiseRequestErrorString:'method must be reimplemented in ST/V subclass'
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4380
indexNotInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4381
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4382
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4383
    "report an error that index is not an Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4384
     (when accessing collections indexed by an integer key).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4385
     The error is reported by raising the NonIntegerIndexSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4386
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4387
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4388
6946
905fcfc8699b signal-classVars replaced by error-class access
Claus Gittinger <cg@exept.de>
parents: 6932
diff changeset
  4389
    ^ NonIntegerIndexError raiseRequestWith:nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4390
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4391
    "Modified: / 8.5.1996 / 09:13:37 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4392
    "Modified: / 26.7.1999 / 10:57:43 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4393
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4394
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4395
indexNotInteger:anIndex
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4396
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4397
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4398
    "report an error that index is not an Integer.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4399
     (when accessing collections indexed by an integer key).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4400
     The error is reported by raising the NonIntegerIndexSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4401
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4402
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4403
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4404
    ^ NonIntegerIndexError raiseRequestWith:anIndex
5755
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
    "Created: / 16.5.1998 / 19:39:41 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4407
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4408
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4409
indexNotIntegerOrOutOfBounds:index
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4410
    "{ Pragma: +optSpace }"
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4411
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4412
    "report an error that index is either non-integral or out of bounds"
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4413
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4414
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4415
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4416
    index isInteger ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4417
	^ self indexNotInteger:index
7216
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4418
    ].
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4419
    ^ self subscriptBoundsError:index
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4420
!
59bfa2ffdcf7 utility
Claus Gittinger <cg@exept.de>
parents: 7215
diff changeset
  4421
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4422
integerCheckError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4423
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4424
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4425
    "generated when a variable declared with an integer type gets a bad value assigned"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4426
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4427
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4428
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4429
"/    ^ self error:'bad assign of ' , self printString ,
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4430
"/                  ' (' , self class name , ') to integer-typed variable'
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  4431
    ^ InvalidTypeError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4432
	raiseRequestErrorString:(
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4433
	    'bad assign of ' , self printString ,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4434
		  ' (' , self class name , ') to integer-typed variable')
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4435
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4436
    "Modified: / 02-11-2012 / 10:25:36 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4437
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4438
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4439
invalidCodeObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4440
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4441
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4442
    "this is sent by VM if it encounters some non-method for execution"
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4443
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4444
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4445
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4446
    "/ self error:'not an executable code object'
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  4447
    ^ ExecutionError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4448
	raiseRequestErrorString:'not an executable code object'
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4449
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4450
    "Created: / 01-08-1997 / 00:16:44 / cg"
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
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4453
invalidMessage
5755
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
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4456
    "this is sent by ST/V code - it's the same as #shouldNotImplement"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4457
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4458
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4459
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4460
    ^ self shouldNotImplement
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4461
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4462
    "Modified (comment): / 02-11-2012 / 10:11:18 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4463
!
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
mustBeRectangle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4466
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4467
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4468
    "report an argument-not-rectangle-error"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4469
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4470
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4471
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4472
    "/ ^ self error:'argument must be a Rectangle'
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4473
    ^ InvalidTypeError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4474
	raiseRequestErrorString:'argument must be a Rectangle'
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4475
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4476
    "Modified: / 02-11-2012 / 10:24:53 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4477
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4478
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4479
mustBeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4480
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4481
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4482
    "report an argument-not-string-error"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4483
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4484
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4485
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4486
    "/ ^ self error:'argument must be a String'
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4487
    ^ InvalidTypeError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4488
	raiseRequestErrorString:'argument must be a String'
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4489
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4490
    "Modified: / 02-11-2012 / 10:24:35 / cg"
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4493
notIndexed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4494
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4495
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4496
    "report an error that receiver has no indexed instance variables.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4497
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4498
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4499
    <context: #return>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4500
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4501
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4502
    ^ SubscriptOutOfBoundsError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4503
	raiseRequestErrorString:'receiver has no indexed variables'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4504
14539
9cc7e1ad8b52 class: Object
Claus Gittinger <cg@exept.de>
parents: 14534
diff changeset
  4505
    "
9cc7e1ad8b52 class: Object
Claus Gittinger <cg@exept.de>
parents: 14534
diff changeset
  4506
     1234 at:4
9cc7e1ad8b52 class: Object
Claus Gittinger <cg@exept.de>
parents: 14534
diff changeset
  4507
    "
9cc7e1ad8b52 class: Object
Claus Gittinger <cg@exept.de>
parents: 14534
diff changeset
  4508
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4509
    "Modified: 26.7.1996 / 16:43:13 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4510
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4511
12050
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
  4512
notYetImplemented
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
  4513
    "{ Pragma: +optSpace }"
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
  4514
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4515
    "report an error that some functionality is not yet implemented.
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4516
     This is here only for compatibility - it has the same meaning as shouldImplement."
12050
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
  4517
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
  4518
    <resource: #skipInDebuggersWalkBack>
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
  4519
15891
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4520
    |sender|
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4521
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4522
    sender := thisContext sender.
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4523
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4524
    ^ UnimplementedFunctionalityError
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4525
	raiseRequestWith:(Message selector:sender selector arguments:sender args)
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4526
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4527
    "Modified: / 02-11-2012 / 10:24:12 / cg"
12050
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
  4528
!
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
  4529
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4530
primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4531
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4532
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4533
    "report an error that some primitive code failed.
14539
9cc7e1ad8b52 class: Object
Claus Gittinger <cg@exept.de>
parents: 14534
diff changeset
  4534
     The error is reported by raising the PrimitiveFailure exception.
9cc7e1ad8b52 class: Object
Claus Gittinger <cg@exept.de>
parents: 14534
diff changeset
  4535
     Sorry for the code duplication: it avoids the extra frame in the debugger."
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4536
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4537
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4538
15891
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4539
    |sender selector|
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4540
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4541
    "do loop to take care of super sends"
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4542
    sender := thisContext sender.
15891
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4543
    [
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4544
	selector := sender selector.
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4545
	selector == #primitiveFailed: or:[selector == #primitiveFailed]
15891
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4546
    ] whileTrue:[sender := sender sender].
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4547
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4548
    ^ PrimitiveFailure raiseRequestWith:(Message selector:selector arguments:sender args)
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4549
		       in:sender.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4550
6005
012813d02bf7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6000
diff changeset
  4551
    "
012813d02bf7 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6000
diff changeset
  4552
     1234 primitiveFailed
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4553
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4554
     [
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4555
	ExternalBytes new   basicAt:40
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4556
     ] on:PrimitiveFailure do:[:ex|
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4557
	ex inspect
8324
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4558
     ]
c6e8039f0d83 Set message as parameter in #primitiveFailed
Stefan Vogel <sv@exept.de>
parents: 8322
diff changeset
  4559
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4560
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4561
8977
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4562
primitiveFailed:messageString
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4563
    "{ Pragma: +optSpace }"
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4564
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4565
    "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
  4566
     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
  4567
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4568
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4569
15891
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4570
    |sender selector|
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4571
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4572
    "do loop to take care of super sends"
8977
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4573
    sender := thisContext sender.
15891
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4574
    [
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4575
	selector := sender selector.
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4576
	selector == #primitiveFailed: or:[selector == #primitiveFailed]
15891
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4577
    ] whileTrue:[sender := sender sender].
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4578
22552f0cd4e4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15854
diff changeset
  4579
    ^ PrimitiveFailure raiseRequestWith:(Message selector:selector arguments:sender args)
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4580
		       errorString:messageString
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4581
		       in:sender.
8977
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4582
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4583
    "
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4584
     1234 primitiveFailed:'this is a test'
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4585
    "
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4586
!
fff5644c031d #primitiveFailed: remember the message implementing the failure
Stefan Vogel <sv@exept.de>
parents: 8975
diff changeset
  4587
6815
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4588
shouldImplement
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4589
    "{ Pragma: +optSpace }"
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4590
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4591
    "report an error that this message/functionality should be implemented.
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4592
     This is send by automatically generated method bodies or inside as-yet-uncoded
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4593
     branches of existing methods."
6815
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4594
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4595
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4596
9216
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4597
    |sender|
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4598
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4599
    sender := thisContext sender.
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4600
12841
d804b0f27fe7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 12733
diff changeset
  4601
    ^ UnimplementedFunctionalityError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4602
	raiseRequestWith:(Message selector:sender selector arguments:sender args)
9216
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4603
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4604
     "
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4605
      self shouldImplement
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4606
     "
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4607
!
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4608
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4609
shouldImplement:what
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4610
    "{ Pragma: +optSpace }"
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4611
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4612
    "report an error that this message/functionality should be implemented.
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4613
     This is send by automatically generated method bodies or inside as-yet-uncoded
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4614
     branches of existing methods."
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4615
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4616
    <resource: #skipInDebuggersWalkBack>
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4617
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4618
    |sender|
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4619
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4620
    sender := thisContext sender.
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4621
12841
d804b0f27fe7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 12733
diff changeset
  4622
    ^ UnimplementedFunctionalityError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4623
	raiseRequestWith:(Message selector:sender selector arguments:sender args)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4624
	errorString:what
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4625
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4626
     "
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4627
      self shouldImplement:'foobar'
9216
6396192d71c6 use UnimplementedFunctionalityError in #subclassResponsibility
Stefan Vogel <sv@exept.de>
parents: 9203
diff changeset
  4628
     "
6815
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4629
!
71582d439a74 Define #shouldImplement
Stefan Vogel <sv@exept.de>
parents: 6805
diff changeset
  4630
11976
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4631
shouldNeverBeReached
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4632
    "report an error that this point may never be reached."
12841
d804b0f27fe7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 12733
diff changeset
  4633
14499
6ed948158d25 class: Object
Claus Gittinger <cg@exept.de>
parents: 14478
diff changeset
  4634
    <resource: #skipInDebuggersWalkBack>
6ed948158d25 class: Object
Claus Gittinger <cg@exept.de>
parents: 14478
diff changeset
  4635
6ed948158d25 class: Object
Claus Gittinger <cg@exept.de>
parents: 14478
diff changeset
  4636
    ^ ExecutionError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4637
	raiseRequestErrorString:'Oops, this may never reached. Something somewhere was terribly wrong.'.
11976
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4638
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4639
    "Modified: / 20-04-2005 / 18:59:28 / janfrog"
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4640
!
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4641
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4642
shouldNeverBeSent
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4643
    "report an error that this message may never be sent to the reciever"
12841
d804b0f27fe7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 12733
diff changeset
  4644
14499
6ed948158d25 class: Object
Claus Gittinger <cg@exept.de>
parents: 14478
diff changeset
  4645
    <resource: #skipInDebuggersWalkBack>
6ed948158d25 class: Object
Claus Gittinger <cg@exept.de>
parents: 14478
diff changeset
  4646
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  4647
    ^ MethodNotAppropriateError
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4648
	raiseRequestErrorString:'This message never may be sent to me'.
11976
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4649
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4650
    "Modified: / 20-04-2005 / 18:59:28 / janfrog"
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4651
    "Modified: / 02-11-2012 / 10:10:42 / cg"
11976
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4652
!
2c8e5e4f97f4 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11790
diff changeset
  4653
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4654
shouldNotImplement
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4655
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4656
12841
d804b0f27fe7 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 12733
diff changeset
  4657
    "report an error that this message should not be implemented -
12733
48cc66ac5d52 comment/format in: #shouldNotImplement
Claus Gittinger <cg@exept.de>
parents: 12718
diff changeset
  4658
     i.e. that a method is invoked which is not appropriate for the receiver."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4659
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4660
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4661
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  4662
    ^ MethodNotAppropriateError
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  4663
	raiseRequestErrorString:'method/functionality is not appropriate for class'.
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4664
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4665
    "Modified: / 02-11-2012 / 10:02:25 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4668
subclassResponsibility
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4669
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4670
12321
ff74d7eab313 added: #shouldImplement:
Claus Gittinger <cg@exept.de>
parents: 12288
diff changeset
  4671
    "report an error that this message should have been reimplemented in a subclass"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4672
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4673
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4674
10877
0666d48f91d1 show the affected method-selector in the subclassResponsibility
Claus Gittinger <cg@exept.de>
parents: 10856
diff changeset
  4675
    ^ SubclassResponsibilityError raiseRequestWith:thisContext sender selector
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4676
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4677
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4678
subclassResponsibility:msg
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4679
    "{ Pragma: +optSpace }"
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4680
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4681
    "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
  4682
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4683
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4684
7334
7da368a2f0da *** empty log message ***
Stefan Vogel <sv@exept.de>
parents: 7322
diff changeset
  4685
    ^ SubclassResponsibilityError raiseRequestErrorString:msg
6721
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4686
!
e5f47c6e2f40 #subclassResponsibility & #subclassResponsibility:
Claus Gittinger <cg@exept.de>
parents: 6718
diff changeset
  4687
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4688
subscriptBoundsError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4689
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4690
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4691
    "report an error that some index is out of bounds.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4692
     (when accessing indexable collections).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4693
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4694
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4695
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4696
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4697
    ^ SubscriptOutOfBoundsSignal raiseRequestWith:nil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4698
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4699
    "Modified: / 26.7.1996 / 16:45:42 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4700
    "Modified: / 26.7.1999 / 10:58:27 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4701
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4702
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4703
subscriptBoundsError:anIndex
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4704
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4705
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4706
    "report an error that anIndex is out of bounds.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4707
     (when accessing indexable collections).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4708
     The error is reported by raising the SubscriptOutOfBoundsSignal exception."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4709
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4710
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4711
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4712
    ^ SubscriptOutOfBoundsError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4713
	raiseRequestWith:anIndex
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4714
	errorString:('subscript (' , anIndex printString , ') out of bounds')
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4715
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  4716
    "Modified: / 17.11.2001 / 22:49:56 / cg"
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4719
typeCheckError
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4720
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4721
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4722
    "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
  4723
     value assigned"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4724
11021
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4725
    <resource: #skipInDebuggersWalkBack>
05de2ecc5763 skip in debugger stuff
Claus Gittinger <cg@exept.de>
parents: 10954
diff changeset
  4726
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4727
"/    ^ self error:'bad assign of ' , self printString ,
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4728
"/                  ' (' , self class name , ') to typed variable'
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4729
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4730
    ^ InvalidTypeError
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4731
	raiseRequestErrorString:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4732
	    ('bad assign of ' , self printString ,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4733
		  ' (' , self class name , ') to typed variable')
14478
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4734
4ff5aab56d26 more specific error reporting for type errors
Claus Gittinger <cg@exept.de>
parents: 14369
diff changeset
  4735
    "Modified: / 02-11-2012 / 10:19:15 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4736
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4737
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4738
!Object methodsFor:'error handling - debugger'!
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4739
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4740
addDebuggerHook:aBlock
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4741
    "add a debugger hook. Any registered hook is evaluated with the exception as
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4742
     argument before a real debugger is entered.
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4743
     Hooks can be used for two purposes:
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4744
	- record exception information in a log file
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4745
	- filter exceptions and either decide to ignore them or to open an alternative
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4746
	  debugger (depending on the exception type, maybe)"
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4747
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4748
    DebuggerHooks isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4749
	DebuggerHooks := OrderedCollection new.
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4750
    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4751
    DebuggerHooks add:aBlock
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4752
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4753
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4754
     Object addDebuggerHook:[:ex | AbortSignal raise].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4755
     (1 / (1-1)).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4756
     Object removeDebuggerHook:(DebuggerHooks first).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4757
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4758
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4759
     Object addDebuggerHook:[:ex | Transcript showCR:ex ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4760
     (1 / (1-1)).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4761
     Object removeDebuggerHook:(DebuggerHooks first).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4762
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4763
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4764
     Object addDebuggerHook:[:ex | ex suspendedContext fullPrintAllOn:Transcript ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4765
     (1 / (1-1)).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4766
     Object removeDebuggerHook:(DebuggerHooks first).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4767
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4768
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4769
     Object addDebuggerHook:[:ex | '/tmp/stx.log' asFilename
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4770
				   appendingFileDo:[:s |
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4771
					s nextPutLine:'----------------------'.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4772
					(Timestamp now printOn:s). s cr.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4773
					ex suspendedContext fullPrintAllOn:s
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4774
				   ]].
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4775
     (1 / (1-1)).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4776
     Object removeDebuggerHook:(DebuggerHooks first).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4777
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4778
!
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4779
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4780
appropriateDebugger:aSelector
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4781
    "{ Pragma: +optSpace }"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4782
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4783
    "return an appropriate debugger to use.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4784
     If there is already a debugger active on the stack, and it is
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4785
     the DebugView, return MiniDebugger (as a last chance) otherwise abort."
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4786
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4787
    |context|
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4788
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4789
    "DebugView cannot run without system processes"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4790
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4791
    (Processor isNil
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4792
    or:[Processor activeProcessIsSystemProcess
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4793
    or:[Smalltalk isInitialized not]]) ifTrue:[
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4794
	^ MiniDebugger
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4795
    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4796
    (Screen isNil or:[Screen default isNil or:[Screen default isOpen not]]) ifTrue:[
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4797
	Debugger isNil ifTrue:[^ nil].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4798
	^ MiniDebugger
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4799
    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4800
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4801
    context := thisContext.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4802
    context := context findNextContextWithSelector:aSelector or:nil or:nil.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4803
    [context notNil] whileTrue:[
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4804
	((context receiver class == Debugger)
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4805
	 and:[context selector == aSelector]) ifTrue:[
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4806
	    "we are already in some Debugger"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4807
	    (Debugger == MiniDebugger) ifTrue:[
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4808
		"we are already in the MiniDebugger"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4809
		ErrorRecursion ifFalse:[
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4810
		    Smalltalk fatalAbort:'recursive error ...'
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4811
		]
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4812
	    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4813
	    MiniDebugger isNil ifTrue:[
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4814
		Smalltalk fatalAbort:'no debugger'
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4815
	    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4816
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4817
	    "ok, an error occured while in the graphical debugger;
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4818
	     lets try MiniDebugger"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4819
	    ^ MiniDebugger
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4820
	].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4821
	context := context findNextContextWithSelector:aSelector or:nil or:nil.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4822
    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4823
    "not within Debugger - no problem"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4824
    ^ Debugger
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4825
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4826
    "Modified: / 23.9.1996 / 12:14:52 / stefan"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4827
    "Modified: / 19.5.1999 / 18:05:00 / cg"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4828
!
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4829
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4830
openDebuggerOnException:ex
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4831
    "{ Pragma: +optSpace }"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4832
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4833
    "enter the debugger on some unhandled exception"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4834
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4835
    |msgString debugger|
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4836
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4837
    msgString := ex descriptionForDebugger.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4838
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4839
    "
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4840
     if there is no debugger, ask for ignore or exit.
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4841
     Exit will terminate the application.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4842
     ignore will raise an AbortOperationRequest.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4843
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4844
    Debugger isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4845
	msgString := 'Error: ' , msgString.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4846
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4847
	thisContext isRecursive ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4848
	    msgString errorPrintCR.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4849
	    Smalltalk fatalAbort:'recursive unhandled exception'
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4850
	].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4851
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4852
	Smalltalk isStandAloneApp ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4853
	    (ex creator == NoHandlerError) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4854
		(HaltInterrupt handles:ex exception) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4855
		    "/ 'Halt ignored' infoPrintCR.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4856
		    ^ nil
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4857
		].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4858
		"don't output the message, if the exception is a UserInterrupt (CTRL-C)"
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4859
		(ex exception creator == UserInterrupt) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4860
		    ex description errorPrintCR.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4861
		    OperatingSystem exit:130.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4862
		].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4863
	    ].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4864
	].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4865
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4866
	(Dialog notNil and:[Screen default notNil]) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4867
	    self
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4868
		errorNotify:msgString
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4869
		from:ex suspendedContext
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4870
		allowDebug:false
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4871
		mayProceed:ex willProceed.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4872
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4873
	    "/ arrive here if proceeded...
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4874
	    ^ nil
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4875
	].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4876
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4877
	"don't output the message, if the exception is a UserInterrupt (CTRL-C)"
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4878
	(ex creator == NoHandlerError
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4879
	 and:[ex exception creator == UserInterrupt]) ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4880
	    OperatingSystem exit:130.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4881
	].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4882
	msgString errorPrintCR.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4883
	'Backtrace:' errorPrintCR.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4884
	thisContext fullPrintAll.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4885
	OperatingSystem exit:1
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4886
    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4887
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4888
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4889
     find an appropriate debugger to use
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4890
    "
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4891
    debugger := self appropriateDebugger:(thisContext selector).
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4892
    debugger isNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4893
	^ AbortOperationRequest raiseRequest
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4894
    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4895
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4896
    "/ call any registered debug hooks.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4897
    "/ These may record or further filter the exception. Each hook gets the exception object and may send any
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4898
    "/ ex-message (ex proceed, ex return etc.) or raise an Abort signal.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4899
    "/ However, the real intent for hooks is to allow saving exceptions in a log file...
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4900
    DebuggerHooks notNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4901
	DebuggerHooks do:[:eachHook |
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4902
	    eachHook value:ex.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4903
	].
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4904
    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4905
    ^ debugger enterException:ex.
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4906
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4907
    "Modified: / 05-12-2011 / 11:53:10 / cg"
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4908
!
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4909
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4910
removeDebuggerHook:aBlock
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4911
    "remove a debugger hook."
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4912
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4913
    DebuggerHooks notNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4914
	DebuggerHooks removeIdentical:aBlock.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  4915
	DebuggerHooks isNil ifTrue:[ DebuggerHooks := nil ].
16311
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4916
    ].
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4917
! !
b4c21b57dfc6 class: Object
Claus Gittinger <cg@exept.de>
parents: 16291
diff changeset
  4918
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4919
!Object methodsFor:'evaluation'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4920
8690
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4921
argumentCount
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4922
    "compatibility with Blocks and Messages.
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4923
     Answer 0, since we only understand #value.
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4924
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4925
     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
  4926
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4927
    ^ 0
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4928
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4929
    "
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4930
	[1 // 0] on:ArithmeticError do:9999
8690
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4931
    "
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4932
!
5894d98a4a61 Implement #argumentCount for Block-compatibility.
Stefan Vogel <sv@exept.de>
parents: 8637
diff changeset
  4933
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4934
value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4935
    "return the receiver itself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4936
     This allows every object to be used where blocks or valueHolders
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4937
     are typically used, and allows for valueHolders and blocks to be
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4938
     used interchangably in some situations.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4939
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4940
     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
  4941
     style ... (the idea was borrowed from the Self language).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4942
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4943
     WARNING: dont 'optimize' away ifXXX: blocks
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4944
	      (i.e. do NOT replace
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4945
			foo ifTrue:[var1] ifFalse:[var2]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4946
	       by:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4947
			foo ifTrue:var1 ifFalse:var2
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4948
	      )
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4949
	      - the compilers will only generate inline code for the if,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4950
		iff the argument(s) are blocks - otherwise, a true send is
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4951
		generated.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4952
	      This 'oprimization' will work semantically correct,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  4953
	      but execute SLOWER instead."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4954
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4955
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4956
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4957
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4958
     #(1 2 3 4) indexOf:5 ifAbsent:0
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4959
     #(1 2 3 4) indexOf:5 ifAbsent:[0]
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4960
     1 > 2 ifTrue:['yes'] ifFalse:['no']
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  4961
     1 > 2 ifTrue:'yes' ifFalse:'no'
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4964
    "DO NOT DO THIS (its slower)
7458
b0ca7546cbd6 CG: comment in value
Stefan Vogel <sv@exept.de>
parents: 7455
diff changeset
  4965
     (1 > 4) ifTrue:a ifFalse:b
5755
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
     USE (the compiler optimizes blocks in if/while):
7458
b0ca7546cbd6 CG: comment in value
Stefan Vogel <sv@exept.de>
parents: 7455
diff changeset
  4968
     (1 > 4) ifTrue:[a] ifFalse:[b]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4969
    "
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
    "Modified: 3.5.1996 / 11:57:08 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4972
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4973
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4974
!Object methodsFor:'finalization'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4975
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4976
disposed
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4977
    "OBSOLETE INTERFACE: use #finalize
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4978
     this is invoked for objects which have been registered
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4979
     in a Registry, when the original object dies.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4980
     Subclasses may redefine this method"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4981
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4982
    <resource: #obsolete>
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4983
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4984
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4985
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4986
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4987
executor
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4988
    "Return the object which does the finalization for me.
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4989
     This interface is also VW & Sqeak compatible,"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4990
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4991
    "for now, send #shallowCopyForFinalization, to be compatible with
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  4992
     classes designed for old ST/X versions"
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
    ^ self shallowCopyForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4995
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  4996
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4997
finalizationLobby
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4998
    "answer a Registry used for finalization.
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  4999
     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
  5000
     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
  5001
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5002
    ^ FinalizationLobby
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5003
!
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5004
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5005
finalize
6439
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  5006
    "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
  5007
     in a Registry, when the original object dies.
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  5008
     Subclasses may redefine this method
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  5009
     This interface is also VW-compatible"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  5010
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  5011
    "send #disposed for compatibility with existing classes that still
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  5012
     implement the obsolete #disposed message"
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  5013
0f841258ec4a Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents: 6421
diff changeset
  5014
    ^ self disposed
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5017
reRegisterForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5018
    "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
  5019
     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
  5020
     the receiver is garbage collected."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5021
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5022
    self finalizationLobby registerChange:self
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5025
registerForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5026
    "register mySelf for later finalization.
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5027
     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
  5028
     the receiver is garbage collected."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5029
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5030
    self finalizationLobby register:self
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5031
!
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5032
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5033
shallowCopyForFinalization
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5034
    "OBSOLETE INTERFACE: use #executor.
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5035
     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
  5036
     (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
  5037
     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
  5038
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5039
    <resource: #obsolete>
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5040
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5041
    ^ self shallowCopy
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5042
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5043
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5044
unregisterForFinalization
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5045
    "unregister mySelf from later finalization"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5046
6461
f5efaff3457b Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents: 6439
diff changeset
  5047
    self finalizationLobby unregister:self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5048
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5049
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5050
!Object methodsFor:'initialization'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5051
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5052
initialize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5053
    "just to ignore initialize to objects which do not need it"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5054
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5055
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5056
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5057
17677
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  5058
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5059
!Object methodsFor:'interrupt handling'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5060
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5061
childSignalInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5062
    "death of a child process (unix process) - do nothing"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5063
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5064
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5065
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5066
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5067
customInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5068
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5069
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5070
    "a custom interrupt - but no handler has defined"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5071
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5072
    self error:'custom interrupt' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5073
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5074
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5075
errorInterrupt:errorID with:aParameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5076
    "subsystem error. The arguments errorID and aParameter are the values passed
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5077
     to the 'errorInterruptWithIDAndParameter(id, param)' function,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5078
     which can be called from C subsystems to raise an (asynchronous)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5079
     error exception.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5080
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5081
     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
  5082
     used from other C subsystems too, to upcast errors.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5083
     Especially, for subsystems which call errorHandler functions asynchronously.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5084
     IDs (currently) used:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5085
	#DisplayError ..... x-error interrupt
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5086
	#XtError      ..... xt-error interrupt (Xt interface is not yet published)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5087
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5088
6263
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  5089
    |handlers handler|
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  5090
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  5091
    handlers := ObjectMemory registeredErrorInterruptHandlers.
4e7a970e4cfc errorInterrupt:with: fixed (care for nil handlers in Objmem)
Claus Gittinger <cg@exept.de>
parents: 6235
diff changeset
  5092
    handlers notNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5093
	handler := handlers at:errorID ifAbsent:nil.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5094
	handler notNil ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5095
	    "/
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5096
	    "/ handler found; let it do whatever it wants ...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5097
	    "/
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5098
	    handler errorInterrupt:errorID with:aParameter.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5099
	    ^ self
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5100
	].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5101
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5102
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5103
    "/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5104
    "/ no handler - raise errorSignal passing the errorId as parameter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5105
    "/
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5106
    ^ Error
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5107
	raiseRequestWith:errorID
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5108
	errorString:('Subsystem error. ErrorID = ' , errorID printString)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5109
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5110
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5111
exceptionInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5112
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5113
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5114
    "exception interrupt - enter debugger"
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
    self error:'exception Interrupt' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5117
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5118
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5119
fpExceptionInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5120
    "{ Pragma: +optSpace }"
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
    "a floating point exception occured - this one
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5123
     has to be handled differently since it comes asynchronous
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5124
     on some machines (for example, on machines with a separate FPU
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5125
     or superscalar architectures. Also, errors from within primitive code
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5126
     (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
  5127
     mechanism this way."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5128
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5129
    |where rec|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5130
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5131
    where := thisContext sender.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5132
    rec := where receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5133
    rec isNumber ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5134
	^ rec class
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5135
	    raise:#domainErrorSignal
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5136
	    receiver:rec
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5137
	    selector:where selector
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5138
	    arguments:(where args asArray)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5139
	    errorString:'floating point exception'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5140
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5141
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5142
    "/ could be in some C-library ...
7402
b9d45ce2463a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 7359
diff changeset
  5143
    ^ DomainError raise
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5144
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5145
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5146
internalError:msg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5147
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5148
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5149
    "this is triggered, when VM hits some bad error,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5150
     such as corrupted class, corrupted method/selector array
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5151
     etc. The argument string gives some more information on what happened.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5152
     (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
  5153
     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
  5154
     this error occurred ...."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5155
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  5156
    VMInternalError raiseWith:self errorString:msg
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5157
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5158
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5159
ioInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5160
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5161
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5162
    "I/O (SIGIO/SIGPOLL) interrupt (supposed to be sent to Processor).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5163
     If we arrive here, there is either no handler (ObjMem>>ioInterruptHandler)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5164
     or it does not understand the ioInterrupt message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5165
     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
  5166
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5167
    self error:'I/O Interrupt - but no handler' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5168
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5169
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5170
memoryInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5171
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5172
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5173
    "out-of-memory interrupt and no handler - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5174
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5175
    self error:'almost out of memory' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5176
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5177
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5178
recursionInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5179
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5180
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5181
    "recursion limit (actually: stack overflow) interrupt.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5182
     This interrupt is triggered, when a process stack grows above
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5183
     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
  5184
     could be caught.
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  5185
     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
  5186
     and the exception can be resumed.
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  5187
     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
  5188
     is not proceedable.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5189
     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
  5190
     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
  5191
     or debug for a while.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5192
     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
  5193
     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
  5194
     terminates the process."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5195
16408
e8076fc8d337 class: Object
Claus Gittinger <cg@exept.de>
parents: 16401
diff changeset
  5196
    |con remaining sender nSkipped caller level n|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5197
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5198
    (con := thisContext) isRecursive ifFalse:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5199
"/        Processor activeProcess usedStackSize < Processor activeProcess maximumStackSize ifTrue:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5200
"/            "/ mhmh - it hit me, but I am not responsible ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5201
"/            'Stray recursionInterrupt ...' infoPrintCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5202
"/            ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5203
"/        ].
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5204
	ObjectMemory infoPrinting ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5205
	    level := 0.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5206
	    caller := thisContext sender.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5207
	    [caller notNil] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5208
		level := level + 1.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5209
		caller := caller sender.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5210
	    ].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5211
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5212
	    'Object [info]: recursionInterrupt from:' printCR.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5213
	    con := con sender.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5214
	    remaining := 500.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5215
	    n := 0.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5216
	    [con notNil and:[remaining > 0]] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5217
		sender := con sender.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5218
		'| ' print. con fullPrint.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5219
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5220
		nSkipped := 0.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5221
		[sender notNil and:[sender sender notNil
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5222
		and:[sender selector == con selector
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5223
		and:[sender sender selector == con selector
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5224
		and:[sender method == con method]]]]] whileTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5225
		    nSkipped := nSkipped + 1.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5226
		    con := sender.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5227
		    sender := con sender.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5228
		].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5229
		nSkipped > 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5230
		    '| ... ***** ' print. nSkipped print. ' recursive contexts skipped *****' printCR.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5231
		].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5232
		con := sender.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5233
		remaining := remaining - 1
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5234
	    ].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5235
	].
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  5236
	^ RecursionInterruptSignal raiseSignal
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5237
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5238
6175
e9970db3e02f recursionInterrupt fixes for win32 (& comment changed)
Claus Gittinger <cg@exept.de>
parents: 6157
diff changeset
  5239
    "Modified: / 10.11.2001 / 15:15:56 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5240
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5241
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5242
schedulerInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5243
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5244
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5245
    "scheduler interrupt (supposed to be sent to Processor).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5246
     If we arrive here, either the Processor does not understand it,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5247
     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
  5248
     big trouble. Enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5249
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5250
    self error:'schedulerInterrupt - but no Processor' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5251
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5252
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5253
signalInterrupt:signalNumber
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5254
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5255
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5256
    "unix signal occured - some signals are handled as Smalltalk Exceptions
10016
e174cf2d1f43 crash save refactored
Claus Gittinger <cg@exept.de>
parents: 9993
diff changeset
  5257
     (SIGPIPE), others (SIGBUS) are rather fatal...
11236
c196f9dedf66 exception description in debugger
Claus Gittinger <cg@exept.de>
parents: 11221
diff changeset
  5258
     In any case, IF a smalltalk-signal has been connected to the OS signal, that one is raised.
c196f9dedf66 exception description in debugger
Claus Gittinger <cg@exept.de>
parents: 11221
diff changeset
  5259
     Otherwise, a dialog is shown, asking the user on how to handle the signal.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5260
     TODO: add another argument, giving more detailed signal info (PC, VADDR,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5261
     exact cause etc.). This helps if segvs occur in primitive code.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5262
     Currently (temporary kludge), these are passed as global variables."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5263
6537
7906825ad5c3 Do not allow to proceed in debugger on SIGSEGV
Stefan Vogel <sv@exept.de>
parents: 6533
diff changeset
  5264
    |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
  5265
     action title screen|
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5266
13254
5cf789a74946 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13229
diff changeset
  5267
    thisContext isRecursive ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5268
	'Severe error: signalInterrupt while processing a signalInterrupt.' errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5269
	'Terminating process ' errorPrint. Processor activeProcess errorPrintCR.
13710
277f3a5697e8 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13656
diff changeset
  5270
"/        GenericException handle:[:ex |
277f3a5697e8 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13656
diff changeset
  5271
"/            "/ ignore any error during termination
277f3a5697e8 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13656
diff changeset
  5272
"/        ] do:[
277f3a5697e8 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13656
diff changeset
  5273
"/           Processor activeProcess terminate.
277f3a5697e8 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13656
diff changeset
  5274
"/        ].
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  5275
	MiniDebugger enter.
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5276
	Processor activeProcess terminateNoSignal.
13254
5cf789a74946 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13229
diff changeset
  5277
    ].
5cf789a74946 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13229
diff changeset
  5278
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5279
    "if there has been an ST-signal installed, use it ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5280
    sig := OperatingSystem operatingSystemSignal:signalNumber.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5281
    sig notNil ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5282
	sig raiseSignalWith:signalNumber.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5283
	^ self.
5755
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
    "/ if handled, raise OSSignalInterruptSignal
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  5287
    OSSignalInterrupt isHandled ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5288
	OSSignalInterrupt raiseRequestWith:signalNumber.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5289
	^ self.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5290
    ].
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5291
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5292
    "
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5293
     special cases
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5294
	- SIGPWR: power failure - write a crash image and continue
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5295
	- SIGHUP: hang up - write a crash image and exit
10922
a1ff606fca18 #signalInterrupt: - comment
Stefan Vogel <sv@exept.de>
parents: 10918
diff changeset
  5296
    "
a1ff606fca18 #signalInterrupt: - comment
Stefan Vogel <sv@exept.de>
parents: 10918
diff changeset
  5297
    (signalNumber == OperatingSystem sigPWR) ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5298
	SnapshotError ignoreIn:[ObjectMemory writeCrashImage].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5299
	^ self.
10922
a1ff606fca18 #signalInterrupt: - comment
Stefan Vogel <sv@exept.de>
parents: 10918
diff changeset
  5300
    ].
a1ff606fca18 #signalInterrupt: - comment
Stefan Vogel <sv@exept.de>
parents: 10918
diff changeset
  5301
    (signalNumber == OperatingSystem sigHUP) ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5302
	SnapshotError ignoreIn:[ObjectMemory writeCrashImage].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5303
	'Object [info]: exit due to hangup signal.' errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5304
	Smalltalk exit:1.
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5305
    ].
5856
6d3df9ad361e save crash image when sigPWR or sigHUP arrives
Claus Gittinger <cg@exept.de>
parents: 5824
diff changeset
  5306
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5307
    name := OperatingSystem nameForSignal:signalNumber.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5308
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5309
    "if there is no screen at all, bring up a mini debugger"
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5310
    (Screen isNil
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5311
     or:[(screen := Screen current) isNil
6778
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  5312
     or:[(screen := Screen default) isNil
87e2d95ce8a4 Raise #drawingOnClosedDeviceSignal instead of #error
Stefan Vogel <sv@exept.de>
parents: 6764
diff changeset
  5313
     or:[screen isOpen not]]]) ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5314
	^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5315
    ].
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5316
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5317
    "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
  5318
     otherwise display stays locked"
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5319
    screen ungrabPointer; ungrabKeyboard.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5320
7031
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5321
    here := thisContext.
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5322
    badContext := here sender.          "the context, in which the signal occurred"
eae2df0a3ad2 Exit Smalltalk in SIGHUP
Stefan Vogel <sv@exept.de>
parents: 6964
diff changeset
  5323
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5324
    "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
  5325
    Screen currentScreenQuerySignal answer:screen do:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5326
	"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5327
	 SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5328
	 since the system will retry the faulty instruction, which leads to
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5329
	 another signal - to avoid frustration, better not offer this option.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5330
	"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5331
	fatal := OperatingSystem isFatalSignal:signalNumber.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5332
	fatal ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5333
	    (Debugger isNil or:[here isRecursive]) ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5334
		'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5335
		^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5336
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5337
	    "
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5338
	     a hard signal - go into debugger immediately
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5339
	    "
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5340
	    msg := 'OS-signal: ', name.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5341
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5342
	    "/ the IRQ-PC is passed as low-hi, to avoid the need
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5343
	    "/ to allocate a LargeInteger in the VM during signal
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5344
	    "/ time. I know, this is ugly.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5345
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5346
	    InterruptPcLow notNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5347
		pc := InterruptPcLow + (InterruptPcHi bitShift:((SmallInteger maxBits + 1) // 2)).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5348
		pc ~~ 0 ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5349
		    msg := msg , ' PC=' , (pc printStringRadix:16)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5350
		].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5351
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5352
	    InterruptAddrLow notNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5353
		addr := InterruptAddrLow + (InterruptAddrHi bitShift:((SmallInteger maxBits + 1) // 2)).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5354
		addr ~~ 0 ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5355
		    msg := msg , ' ADDR=' , (addr printStringRadix:16)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5356
		].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5357
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5358
	    Debugger enter:here withMessage:msg mayProceed:false.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5359
	    "unreachable"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5360
	    ^ nil.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5361
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5362
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5363
	"if possible, open an option box asking the user what do.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5364
	 Otherwise, start a debugger"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5365
	Dialog notNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5366
	    OperatingSystem isOSXlike ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5367
		titles := #('Save crash image' 'Dump core' 'GDB' 'Exit ST/X' 'Debug').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5368
		actions := #(save core gdb exit debug).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5369
	    ] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5370
		titles := #('Save crash image' 'Dump core' 'Exit ST/X' 'Debug').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5371
		actions := #(save core exit debug).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5372
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5373
	    action := nil.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5374
	    title := 'OS Signal caught (' , name, ')'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5375
	    title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5376
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5377
	    "/ if caught while in the scheduler or event dispatcher,
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5378
	    "/ a modal dialog is not possible ...
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5379
	    "/ (therefore, abort & return does not makes sense)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5380
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5381
	    Processor activeProcess isSystemProcess ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5382
		titles := #('Abort') , titles.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5383
		actions := #(abort), actions.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5384
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5385
		badContext canReturn ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5386
		    titles := #('Return') , titles.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5387
		    actions :=  #(return), actions.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5388
		].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5389
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5390
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5391
	    fatal ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5392
		titles := titles, #('Ignore').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5393
		actions := actions , #(ignore).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5394
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5395
	    action := Dialog choose:title
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5396
			     labels:titles
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5397
			     values:actions
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5398
			     default:(fatal ifTrue:[nil] ifFalse:[#ignore]).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5399
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5400
	    "Dialog may fail (if system process), default action is debug"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5401
	    action isEmptyOrNil ifTrue:[action := #debug].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5402
	] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5403
	    action := #debug.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5404
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5405
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5406
	action == #save ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5407
	    ObjectMemory writeCrashImage
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5408
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5409
	action == #gdb ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5410
	    |pid|
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5411
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5412
	    pid := OperatingSystem getProcessId.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5413
	    OperatingSystem openTerminalWithCommand:('gdb -p %1' bindWith:pid) inBackground:true.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5414
	    MiniDebugger enter. "/ to stop, so gdb can show where we are
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5415
	    AbortOperationRequest raise.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5416
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5417
	action == #core ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5418
	    Smalltalk fatalAbort
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5419
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5420
	action == #exit ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5421
	    Smalltalk exit:10.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5422
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5423
	action == #return ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5424
	    badContext return
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5425
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5426
	action == #abort ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5427
	    AbortOperationRequest raise.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5428
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5429
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5430
	action == #debug ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5431
	    Debugger isNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5432
		^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5433
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5434
	    Debugger enter:here withMessage:('OS-Signal ', name) mayProceed:true.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5435
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5436
	"action == #ignore"
13261
Claus Gittinger <cg@exept.de>
parents: 13258
diff changeset
  5437
    ].
Claus Gittinger <cg@exept.de>
parents: 13258
diff changeset
  5438
13710
277f3a5697e8 changed: #signalInterrupt:
Claus Gittinger <cg@exept.de>
parents: 13656
diff changeset
  5439
    "Modified: / 15-09-2011 / 16:38:14 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5440
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5441
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5442
spyInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5443
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5444
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5445
    "spy interrupt and no handler - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5446
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5447
    self error:'spy Interrupt - but no handler' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5448
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5449
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5450
startMiniDebuggerOrExit:text
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5451
    "some critical condition happened.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5452
     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
  5453
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5454
    MiniDebugger isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5455
	"a system without debugging facilities (i.e. a standalone system)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5456
	 output a message and exit."
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5457
	('Object [error]: exit due to ', text, ' - and no debugger.') errorPrintCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5458
	OperatingSystem exit:99.
6388
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5459
    ].
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5460
    MiniDebugger enterWithMessage:text mayProceed:true.
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5461
!
41396e0cc89f Fix #signalInterrupt: for multi-display and headless.
Stefan Vogel <sv@exept.de>
parents: 6328
diff changeset
  5462
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5463
timerInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5464
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5465
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5466
    "timer interrupt and no handler - enter debugger"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5467
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5468
    self error:'timer Interrupt - but no handler' mayProceed:true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5469
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5470
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5471
userInterrupt
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5472
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5473
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5474
    "user (^c) interrupt.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5475
     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
  5476
     controlling tty (i.e. in the xterm)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5477
6466
ae28dd895a58 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6461
diff changeset
  5478
    UserInterruptSignal raiseRequest
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5479
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5480
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5481
userInterruptIn:aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5482
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5483
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5484
    "user (^c) interrupt - enter debugger, but show aContext
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5485
     as top-context.
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5486
     This is used to hide any intermediate scheduler contexts,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5487
     in case of an interrupted process. Typically, this is sent by
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5488
     the WindowGroup, when a keyboardEvent for the ctrl-C key is
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5489
     processed."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5490
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5491
    <context: #return>
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5492
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5493
    UserInterruptSignal raiseRequestWith:nil errorString:nil in:aContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5494
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5495
    "Created: / 18.10.1996 / 20:46:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5496
    "Modified: / 20.10.1996 / 13:06:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5497
    "Modified: / 26.7.1999 / 10:58:49 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5498
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5499
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5500
!Object methodsFor:'message sending'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5501
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5502
perform:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5503
    "send the message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5504
11335
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  5505
    <resource: #skipInDebuggersWalkBack>
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  5506
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5507
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  5508
#ifdef __SCHTEAM__
18238
0b3b5ced099d oops - sorry
Claus Gittinger <cg@exept.de>
parents: 18231
diff changeset
  5509
    return context.PERFORM(self, aSelector);
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5510
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5511
    REGISTER OBJ sel = aSelector;
16588
eb24b473a3ba Fix for bug in Object>>perform(with:(with:)) - care for nil or SmallInteger selectors.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16583
diff changeset
  5512
    int hash0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5513
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5514
    if (InterruptPending == nil) {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5515
	struct inlineCache *pIlc;
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5516
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5517
# define nways 2
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5518
# define nilcs 131
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5519
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5520
# define SEL_AND_ILC_INIT_1(l)   { { nil, nil } , { __ILCPERF0(l) , __ILCPERF0(l) } , 0 }
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5521
# define SEL_AND_ILC_INIT_2(l)   SEL_AND_ILC_INIT_1(l)   , SEL_AND_ILC_INIT_1(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5522
# define SEL_AND_ILC_INIT_4(l)   SEL_AND_ILC_INIT_2(l)   , SEL_AND_ILC_INIT_2(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5523
# define SEL_AND_ILC_INIT_8(l)   SEL_AND_ILC_INIT_4(l)   , SEL_AND_ILC_INIT_4(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5524
# define SEL_AND_ILC_INIT_16(l)  SEL_AND_ILC_INIT_8(l)   , SEL_AND_ILC_INIT_8(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5525
# define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5526
# define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5527
# define SEL_AND_ILC_INIT_64(l)  SEL_AND_ILC_INIT_32(l)  , SEL_AND_ILC_INIT_32(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5528
# define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l)  , SEL_AND_ILC_INIT_64(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5529
# define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5530
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5531
# define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l)
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5532
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5533
	static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  5534
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5535
# undef SEL_AND_ILC_INIT_1
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5536
# undef SEL_AND_ILC_INIT_2
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5537
# undef SEL_AND_ILC_INIT_4
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5538
# undef SEL_AND_ILC_INIT_8
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5539
# undef SEL_AND_ILC_INIT_16
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5540
# undef SEL_AND_ILC_INIT_32
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5541
# undef SEL_AND_ILC_INIT_64
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5542
# undef SEL_AND_ILC_INIT_128
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5543
# undef SEL_AND_ILC_INIT_256
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5544
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5545
# undef SEL_AND_ILC_INIT_131
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5546
# undef SEL_AND_ILC_INIT_257
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5547
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5548
# define TRY(n)                                  \
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5549
	if (sel == sel_and_ilc[hash0].sel[n]) { \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5550
	    pIlc = &sel_and_ilc[hash0].ilc[n];  \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5551
	    goto perform0_send_and_return;      \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5552
	}
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5553
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5554
	if (__isNonNilObject(sel)) {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5555
	    hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5556
	} else {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5557
	    /* sel is either nil or smallint, use its value as hash */
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5558
	    hash0 = (INT)sel % nilcs;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5559
	}
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5560
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5561
	TRY(0);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5562
	TRY(1);
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5563
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5564
# undef TRY
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5565
	/*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5566
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5567
	pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5568
	sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5569
	sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5570
	pIlc->ilc_func = __SEND0ADDR__;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5571
	if (pIlc->ilc_poly) {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5572
	    __flushPolyCache(pIlc->ilc_poly);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5573
	    pIlc->ilc_poly = 0;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5574
	}
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  5575
perform0_send_and_return:
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5576
	RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5577
    } else {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5578
	static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5579
	RETURN (_SEND0(self, aSelector, nil, &ilc0));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5580
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  5581
#endif /* not __SCHTEAM__ */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5582
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5583
    ^ self perform:aSelector withArguments:#()
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5586
perform:aSelector inClass:aClass withArguments:argArray
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5587
    "send the message aSelector with all args taken from argArray
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5588
     to the receiver as a super-send message.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5589
     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
  5590
     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
  5591
     immediate superclass).
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  5592
     Thus, it is (theoretically) possible to do
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5593
	 '5 perform:#< inClass:Magnitude withArguments:#(6)'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5594
     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
  5595
     This method is used by the interpreter to evaluate super sends
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5596
     and could be used for very special behavior (language extension ?).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5597
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5598
     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
  5599
5769
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5600
    |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
  5601
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5602
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5603
     check, if aClass is really a superclass of the receiver
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5604
    "
5769
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5605
    myClass := self class.
8f874be55bc9 lookup-class check in #perform:inClass was too strong.
Claus Gittinger <cg@exept.de>
parents: 5755
diff changeset
  5606
    (myClass == aClass or:[myClass isSubclassOf:aClass]) ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5607
	self error:'lookup-class argument is not a superclass of the receiver'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5608
	^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5609
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5610
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  5611
#ifdef __SCHTEAM__
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5612
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5613
    REGISTER OBJ *argP;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5614
    int nargs, i;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5615
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  5616
    if (__isArrayLike(argArray)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5617
	nargs = __arraySize(argArray);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5618
	argP = __arrayVal(argArray);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5619
    } else {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5620
	if (__isNonNilObject(argArray)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5621
	    static struct inlineCache ilcSize = __ILC0(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5622
	    numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5623
	    if (!__isSmallInteger(numberOfArgs))
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5624
		goto bad;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5625
	    nargs = __intVal(numberOfArgs);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5626
	    argP = (OBJ *)(&a1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5627
	    for (i=1; i <= nargs; i++) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5628
		*argP++ = __AT_(argArray, __mkSmallInteger(i));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5629
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5630
	    argP = (OBJ *)(&a1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5631
	} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5632
	    nargs = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5633
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5634
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5635
    switch (nargs) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5636
	case 0:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5637
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5638
		static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5639
		RETURN ( _SEND0(self, aSelector, aClass, &ilc0));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5640
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5641
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5642
	case 1:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5643
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5644
		static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5645
		RETURN ( _SEND1(self, aSelector, aClass, &ilc1, argP[0]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5646
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5647
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5648
	case 2:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5649
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5650
		static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5651
		RETURN ( _SEND2(self, aSelector, aClass, &ilc2, argP[0], argP[1]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5652
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5653
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5654
	case 3:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5655
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5656
		static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5657
		RETURN ( _SEND3(self, aSelector, aClass, &ilc3,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5658
				argP[0], argP[1], argP[2]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5659
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5660
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5661
	case 4:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5662
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5663
		static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5664
		RETURN ( _SEND4(self, aSelector, aClass, &ilc4,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5665
				argP[0], argP[1], argP[2], argP[3]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5666
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5667
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5668
	case 5:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5669
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5670
		static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5671
		RETURN ( _SEND5(self, aSelector, aClass, &ilc5,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5672
				argP[0], argP[1], argP[2], argP[3], argP[4]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5673
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5674
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5675
	case 6:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5676
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5677
		static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5678
		RETURN ( _SEND6(self, aSelector, aClass, &ilc6,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5679
				argP[0], argP[1], argP[2], argP[3], argP[4], argP[5]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5680
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5681
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5682
	case 7:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5683
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5684
		static struct inlineCache ilc7 = __DUMMYILCSELF7(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5685
		RETURN ( _SEND7(self, aSelector, aClass, &ilc7,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5686
				argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5687
				argP[6]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5688
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5689
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5690
	case 8:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5691
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5692
		static struct inlineCache ilc8 = __DUMMYILCSELF8(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5693
		RETURN ( _SEND8(self, aSelector, aClass, &ilc8,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5694
				argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5695
				argP[6], argP[7]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5696
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5697
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5698
	case 9:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5699
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5700
		static struct inlineCache ilc9 = __DUMMYILCSELF9(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5701
		RETURN ( _SEND9(self, aSelector, aClass, &ilc9,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5702
				argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5703
				argP[6], argP[7], argP[8]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5704
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5705
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5706
	case 10:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5707
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5708
		static struct inlineCache ilc10 = __DUMMYILCSELF10(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5709
		RETURN ( _SEND10(self, aSelector, aClass, &ilc10,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5710
				 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5711
				 argP[6], argP[7], argP[8], argP[9]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5712
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5713
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5714
	case 11:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5715
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5716
		static struct inlineCache ilc11 = __DUMMYILCSELF11(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5717
		RETURN ( _SEND11(self, aSelector, aClass, &ilc11,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5718
				 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5719
				 argP[6], argP[7], argP[8], argP[9], argP[10]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5720
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5721
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5722
	case 12:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5723
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5724
		static struct inlineCache ilc12 = __DUMMYILCSELF12(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5725
		RETURN ( _SEND12(self, aSelector, aClass, &ilc12,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5726
				 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5727
				 argP[6], argP[7], argP[8], argP[9], argP[10],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5728
				 argP[11]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5729
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5730
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5731
	case 13:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5732
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5733
		static struct inlineCache ilc13 = __DUMMYILCSELF13(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5734
		RETURN ( _SEND13(self, aSelector, aClass, &ilc13,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5735
				 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5736
				 argP[6], argP[7], argP[8], argP[9], argP[10],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5737
				 argP[11], argP[12]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5738
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5739
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5740
	case 14:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5741
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5742
		static struct inlineCache ilc14 = __DUMMYILCSELF14(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5743
		RETURN ( _SEND14(self, aSelector, aClass, &ilc14,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5744
				 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5745
				 argP[6], argP[7], argP[8], argP[9], argP[10],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5746
				 argP[11], argP[12], argP[13]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5747
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5748
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5749
	case 15:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5750
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5751
		static struct inlineCache ilc15 = __DUMMYILCSELF15(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5752
		RETURN ( _SEND15(self, aSelector, aClass, &ilc15,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5753
				 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5754
				 argP[6], argP[7], argP[8], argP[9], argP[10],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5755
				 argP[11], argP[12], argP[13], argP[14]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5756
	    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5757
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5758
# ifdef _SEND16
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5759
	case 16:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5760
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5761
		static struct inlineCache ilc16 = __DUMMYILCSELF16(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5762
		RETURN ( _SEND16(self, aSelector, aClass, &ilc15,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5763
				 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5764
				 argP[6], argP[7], argP[8], argP[9], argP[10],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5765
				 argP[11], argP[12], argP[13], argP[14], argP[15]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5766
	    }
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5767
# endif
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5768
# ifdef _SEND17
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5769
	case 17:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5770
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5771
		static struct inlineCache ilc17 = __DUMMYILCSELF17(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5772
		RETURN ( _SEND17(self, aSelector, aClass, &ilc15,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5773
				 argP[0], argP[1], argP[2], argP[3], argP[4], argP[5],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5774
				 argP[6], argP[7], argP[8], argP[9], argP[10],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5775
				 argP[11], argP[12], argP[13], argP[14], argP[15], argP[16]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5776
	    }
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5777
# endif
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5778
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5779
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
bad:;
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  5782
#endif /* not __SCHTEAM__ */
5755
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
    "/ arrive here, if bad number of arguments (too many)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5785
    "/ ST/X (currently) only allows up to 15 method arguments
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5786
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5787
    ^ self primitiveFailed
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
perform:aSelector with:arg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5791
    "send the one-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5792
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5793
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  5794
#ifdef __SCHTEAM__
18238
0b3b5ced099d oops - sorry
Claus Gittinger <cg@exept.de>
parents: 18231
diff changeset
  5795
    return context.PERFORM_WITH(self, aSelector, arg);
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5796
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5797
    REGISTER OBJ sel = aSelector;
16588
eb24b473a3ba Fix for bug in Object>>perform(with:(with:)) - care for nil or SmallInteger selectors.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16583
diff changeset
  5798
    int hash0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5799
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5800
    if (InterruptPending == nil) {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5801
	struct inlineCache *pIlc;
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5802
# undef nways
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5803
# define nways 2
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5804
# undef nilcs
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5805
# define nilcs 131
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5806
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5807
# define SEL_AND_ILC_INIT_1(l)   { { nil, nil } , { __ILCPERF1(l) , __ILCPERF1(l)  } , 0 }
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5808
# define SEL_AND_ILC_INIT_2(l)   SEL_AND_ILC_INIT_1(l)   , SEL_AND_ILC_INIT_1(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5809
# define SEL_AND_ILC_INIT_4(l)   SEL_AND_ILC_INIT_2(l)   , SEL_AND_ILC_INIT_2(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5810
# define SEL_AND_ILC_INIT_8(l)   SEL_AND_ILC_INIT_4(l)   , SEL_AND_ILC_INIT_4(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5811
# define SEL_AND_ILC_INIT_16(l)  SEL_AND_ILC_INIT_8(l)   , SEL_AND_ILC_INIT_8(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5812
# define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5813
# define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5814
# define SEL_AND_ILC_INIT_64(l)  SEL_AND_ILC_INIT_32(l)  , SEL_AND_ILC_INIT_32(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5815
# define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l)  , SEL_AND_ILC_INIT_64(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5816
# define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5817
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5818
# define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l)
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5819
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5820
	static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  5821
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5822
# undef SEL_AND_ILC_INIT_1
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5823
# undef SEL_AND_ILC_INIT_2
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5824
# undef SEL_AND_ILC_INIT_4
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5825
# undef SEL_AND_ILC_INIT_8
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5826
# undef SEL_AND_ILC_INIT_16
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5827
# undef SEL_AND_ILC_INIT_32
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5828
# undef SEL_AND_ILC_INIT_64
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5829
# undef SEL_AND_ILC_INIT_128
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5830
# undef SEL_AND_ILC_INIT_256
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5831
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5832
# undef SEL_AND_ILC_INIT_131
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5833
# undef SEL_AND_ILC_INIT_257
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5834
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5835
# define TRY(n)                                  \
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5836
	if (sel == sel_and_ilc[hash0].sel[n]) { \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5837
	    pIlc = &sel_and_ilc[hash0].ilc[n];  \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5838
	    goto perform1_send_and_return;      \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5839
	}
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5840
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5841
	if (__isNonNilObject(sel)) {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5842
	    hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5843
	} else {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5844
	    /* sel is either nil or smallint, use its value as hash */
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5845
	    hash0 = (INT)sel % nilcs;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5846
	}
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5847
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5848
	TRY(0);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5849
	TRY(1);
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5850
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5851
# undef TRY
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5852
	/*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5853
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5854
	pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5855
	sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5856
	sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5857
	pIlc->ilc_func = __SEND1ADDR__;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5858
	if (pIlc->ilc_poly) {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5859
	    __flushPolyCache(pIlc->ilc_poly);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5860
	    pIlc->ilc_poly = 0;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5861
	}
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5862
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  5863
perform1_send_and_return:
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5864
	RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5865
    } else {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5866
	static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5867
	RETURN (_SEND1(self, aSelector, nil, &ilc1, arg));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5868
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  5869
#endif /* not __SCHTEAM__ */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5870
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5871
    ^ self perform:aSelector withArguments:(Array with:arg)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5872
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5873
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5874
perform:aSelector with:arg1 with:arg2
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5875
    "send the two-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5876
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5877
%{
18263
1fadeed7749f schteam stuff
Claus Gittinger <cg@exept.de>
parents: 18254
diff changeset
  5878
#ifdef __SCHTEAM__
1fadeed7749f schteam stuff
Claus Gittinger <cg@exept.de>
parents: 18254
diff changeset
  5879
    return context.PERFORM_WITH2(self, aSelector, arg1, arg2);
1fadeed7749f schteam stuff
Claus Gittinger <cg@exept.de>
parents: 18254
diff changeset
  5880
#else
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  5881
    REGISTER OBJ sel = aSelector;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5882
    struct inlineCache *pIlc;
16588
eb24b473a3ba Fix for bug in Object>>perform(with:(with:)) - care for nil or SmallInteger selectors.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16583
diff changeset
  5883
    int hash0;
5755
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
    if (InterruptPending == nil) {
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5886
# undef nways
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5887
# define nways 2
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5888
# undef nilcs
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5889
# define nilcs 131
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5890
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5891
# define SEL_AND_ILC_INIT_1(l)   { { nil, nil } , { __ILCPERF2(l) , __ILCPERF2(l) } , 0 }
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5892
# define SEL_AND_ILC_INIT_2(l)   SEL_AND_ILC_INIT_1(l)   , SEL_AND_ILC_INIT_1(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5893
# define SEL_AND_ILC_INIT_4(l)   SEL_AND_ILC_INIT_2(l)   , SEL_AND_ILC_INIT_2(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5894
# define SEL_AND_ILC_INIT_8(l)   SEL_AND_ILC_INIT_4(l)   , SEL_AND_ILC_INIT_4(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5895
# define SEL_AND_ILC_INIT_16(l)  SEL_AND_ILC_INIT_8(l)   , SEL_AND_ILC_INIT_8(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5896
# define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5897
# define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5898
# define SEL_AND_ILC_INIT_64(l)  SEL_AND_ILC_INIT_32(l)  , SEL_AND_ILC_INIT_32(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5899
# define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l)  , SEL_AND_ILC_INIT_64(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5900
# define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5901
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5902
# define SEL_AND_ILC_INIT_131(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_2(l) , SEL_AND_ILC_INIT_1(l)
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5903
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5904
	static struct { OBJ sel[nways]; struct inlineCache ilc[nways]; int flip; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_131(@line) };
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  5905
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5906
# undef SEL_AND_ILC_INIT_1
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5907
# undef SEL_AND_ILC_INIT_2
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5908
# undef SEL_AND_ILC_INIT_4
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5909
# undef SEL_AND_ILC_INIT_8
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5910
# undef SEL_AND_ILC_INIT_16
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5911
# undef SEL_AND_ILC_INIT_32
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5912
# undef SEL_AND_ILC_INIT_64
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5913
# undef SEL_AND_ILC_INIT_128
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5914
# undef SEL_AND_ILC_INIT_256
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5915
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5916
# undef SEL_AND_ILC_INIT_131
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5917
# undef SEL_AND_ILC_INIT_257
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5918
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5919
# define TRY(n)                                  \
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5920
	if (sel == sel_and_ilc[hash0].sel[n]) { \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5921
	    pIlc = &sel_and_ilc[hash0].ilc[n];  \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5922
	    goto perform2_send_and_return;      \
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5923
	}
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5924
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5925
	if (__isNonNilObject(sel)) {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5926
	    hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5927
	} else {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5928
	    /* sel is either nil or smallint, use its value as hash */
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5929
	    hash0 = (INT)sel % nilcs;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5930
	}
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5931
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5932
	TRY(0);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5933
	TRY(1);
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5934
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  5935
# undef TRY
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5936
	/*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5937
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5938
	pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip];
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5939
	sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5940
	sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5941
	pIlc->ilc_func = __SEND2ADDR__;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5942
	if (pIlc->ilc_poly) {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5943
	    __flushPolyCache(pIlc->ilc_poly);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5944
	    pIlc->ilc_poly = 0;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5945
	}
16169
5a4e80279be4 Object>>#perform:(with:(with:)): more performant implementation
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16126
diff changeset
  5946
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  5947
perform2_send_and_return:
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5948
	RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5949
    } else {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5950
	static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  5951
	RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5952
    }
18263
1fadeed7749f schteam stuff
Claus Gittinger <cg@exept.de>
parents: 18254
diff changeset
  5953
#endif /* not SCHTEAM */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5954
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5955
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5956
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5957
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5958
perform:aSelector with:arg1 with:arg2 with:arg3
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5959
    "send the three-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5960
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5961
%{
18263
1fadeed7749f schteam stuff
Claus Gittinger <cg@exept.de>
parents: 18254
diff changeset
  5962
#ifdef __SCHTEAM__
1fadeed7749f schteam stuff
Claus Gittinger <cg@exept.de>
parents: 18254
diff changeset
  5963
    return context.PERFORM_WITH3(self, aSelector, arg1, arg2, arg3);
1fadeed7749f schteam stuff
Claus Gittinger <cg@exept.de>
parents: 18254
diff changeset
  5964
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5965
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5966
    static struct inlineCache ilc_0 = __ILCPERF3(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5967
    static struct inlineCache ilc_1 = __ILCPERF3(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5968
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5969
    static OBJ last_1 = nil;
18185
f454e3590ebc missing type in flip
Claus Gittinger <cg@exept.de>
parents: 18151
diff changeset
  5970
    static int flip = 0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5971
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5972
    if (InterruptPending == nil) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5973
	if (aSelector != last_0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5974
	    if (aSelector != last_1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5975
		if (flip) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5976
		    pIlc = &ilc_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5977
		    flip = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5978
		    last_0 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5979
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5980
		    pIlc = &ilc_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5981
		    flip = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5982
		    last_1 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5983
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5984
		pIlc->ilc_func = __SEND3ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5985
		if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5986
		    __flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5987
		    pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5988
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5989
	    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5990
		pIlc = &ilc_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5991
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5992
	} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5993
	    pIlc = &ilc_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5994
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5995
	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
  5996
    } else {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5997
	static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  5998
	RETURN (_SEND3(self, aSelector, nil, &ilc3, arg1, arg2, arg3));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  5999
    }
18263
1fadeed7749f schteam stuff
Claus Gittinger <cg@exept.de>
parents: 18254
diff changeset
  6000
#endif /* not SCHTEAM */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6001
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6002
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6003
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6004
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6005
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6006
perform:aSelector with:arg1 with:arg2 with:arg3 with:arg4
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6007
    "send the four-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6008
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6009
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6010
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6011
    static struct inlineCache ilc_0 = __ILCPERF4(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6012
    static struct inlineCache ilc_1 = __ILCPERF4(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6013
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6014
    static OBJ last_1 = nil;
18185
f454e3590ebc missing type in flip
Claus Gittinger <cg@exept.de>
parents: 18151
diff changeset
  6015
    static int flip = 0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6016
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6017
    if (InterruptPending == nil) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6018
	if (aSelector != last_0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6019
	    if (aSelector != last_1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6020
		if (flip) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6021
		    pIlc = &ilc_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6022
		    flip = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6023
		    last_0 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6024
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6025
		    pIlc = &ilc_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6026
		    flip = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6027
		    last_1 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6028
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6029
		pIlc->ilc_func = __SEND4ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6030
		if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6031
		    __flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6032
		    pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6033
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6034
	    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6035
		pIlc = &ilc_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6036
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6037
	} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6038
	    pIlc = &ilc_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6039
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6040
	RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6041
				     arg1, arg2, arg3, arg4) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6042
    } else {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6043
	static struct inlineCache ilc4 = __DUMMYILCSELF4(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6044
	RETURN (_SEND4(self, aSelector, nil, &ilc4,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6045
		       arg1, arg2, arg3, arg4));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6046
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6047
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6048
    ^ 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
  6049
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6050
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6051
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6052
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
  6053
    "send the five-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6054
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6055
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6056
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6057
    static struct inlineCache ilc_0 = __ILCPERF5(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6058
    static struct inlineCache ilc_1 = __ILCPERF5(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6059
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6060
    static OBJ last_1 = nil;
18185
f454e3590ebc missing type in flip
Claus Gittinger <cg@exept.de>
parents: 18151
diff changeset
  6061
    static int flip = 0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6062
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6063
    if (InterruptPending == nil) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6064
	if (aSelector != last_0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6065
	    if (aSelector != last_1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6066
		if (flip) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6067
		    pIlc = &ilc_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6068
		    flip = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6069
		    last_0 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6070
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6071
		    pIlc = &ilc_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6072
		    flip = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6073
		    last_1 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6074
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6075
		pIlc->ilc_func = __SEND5ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6076
		if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6077
		    __flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6078
		    pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6079
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6080
	    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6081
		pIlc = &ilc_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6082
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6083
	} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6084
	    pIlc = &ilc_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6085
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6086
	RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6087
				     arg1, arg2, arg3, arg4, arg5) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6088
    } else {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6089
	static struct inlineCache ilc5 = __DUMMYILCSELF5(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6090
	RETURN (_SEND5(self, aSelector, nil, &ilc5,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6091
		       arg1, arg2, arg3, arg4, arg5));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6092
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6093
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6094
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6095
						  with:arg5)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6096
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6097
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6098
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6099
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
  6100
    "send the six-arg-message aSelector to the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6101
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6102
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6103
    struct inlineCache *pIlc;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6104
    static struct inlineCache ilc_0 = __ILCPERF6(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6105
    static struct inlineCache ilc_1 = __ILCPERF6(@line);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6106
    static OBJ last_0 = nil;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6107
    static OBJ last_1 = nil;
18185
f454e3590ebc missing type in flip
Claus Gittinger <cg@exept.de>
parents: 18151
diff changeset
  6108
    static int flip = 0;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6109
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6110
    if (InterruptPending == nil) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6111
	if (aSelector != last_0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6112
	    if (aSelector != last_1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6113
		if (flip) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6114
		    pIlc = &ilc_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6115
		    flip = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6116
		    last_0 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6117
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6118
		    pIlc = &ilc_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6119
		    flip = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6120
		    last_1 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6121
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6122
		pIlc->ilc_func = __SEND6ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6123
		if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6124
		    __flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6125
		    pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6126
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6127
	    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6128
		pIlc = &ilc_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6129
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6130
	} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6131
	    pIlc = &ilc_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6132
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6133
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6134
	RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6135
				     arg1, arg2, arg3, arg4, arg5, arg6) );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6136
    } else {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6137
	static struct inlineCache ilc6 = __DUMMYILCSELF6(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6138
	RETURN (_SEND6(self, aSelector, nil, &ilc6,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6139
		       arg1, arg2, arg3, arg4, arg5, arg6));
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6140
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6141
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6142
    ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6143
						  with:arg5 with:arg6)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6144
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6145
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6146
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6147
perform:aSelector withArguments:argArray
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  6148
    "send the message aSelector with all args taken from argArray
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6149
     to the receiver."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6150
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6151
    |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
  6152
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6153
%{
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  6154
#ifdef __SCHTEAM__
18238
0b3b5ced099d oops - sorry
Claus Gittinger <cg@exept.de>
parents: 18231
diff changeset
  6155
    return context.PERFORM_WITH_ARGUMENTS(self, aSelector, argArray);
0b3b5ced099d oops - sorry
Claus Gittinger <cg@exept.de>
parents: 18231
diff changeset
  6156
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6157
    REGISTER OBJ *argP;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6158
    int nargs;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6159
    OBJ l;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6160
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  6161
    if (__isArrayLike(argArray)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6162
	nargs = __arraySize(argArray);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6163
	argP = __arrayVal(argArray);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6164
    } else {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6165
	if (__isNonNilObject(argArray)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6166
	    static struct inlineCache ilcSize = __ILC0(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6167
	    int i;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6168
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6169
	    numberOfArgs = (*ilcSize.ilc_func)(argArray, @symbol(size), nil, &ilcSize);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6170
	    if (!__isSmallInteger(numberOfArgs))
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6171
		goto bad;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6172
	    nargs = __intVal(numberOfArgs);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6173
	    argP = (OBJ *)(&a1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6174
	    for (i=1; i <= nargs; i++) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6175
		*argP++ = __AT_(argArray, __mkSmallInteger(i));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6176
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6177
	    argP = (OBJ *)(&a1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6178
	} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6179
	    nargs = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6180
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6181
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6182
    switch (nargs) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6183
	case 0:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6184
	    if (InterruptPending == nil) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6185
		static OBJ last0_0 = nil; static struct inlineCache ilc0_0 = __ILCPERF0(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6186
		static OBJ last0_1 = nil; static struct inlineCache ilc0_1 = __ILCPERF0(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6187
		static OBJ last0_2 = nil; static struct inlineCache ilc0_2 = __ILCPERF0(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6188
		static OBJ last0_3 = nil; static struct inlineCache ilc0_3 = __ILCPERF0(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6189
		static int flip0 = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6190
		struct inlineCache *pIlc;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6191
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6192
		if (aSelector == last0_0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6193
		    pIlc = &ilc0_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6194
		} else if (aSelector == last0_1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6195
		    pIlc = &ilc0_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6196
		} else if (aSelector == last0_2) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6197
		    pIlc = &ilc0_2;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6198
		} else if (aSelector == last0_3) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6199
		    pIlc = &ilc0_3;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6200
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6201
		    if (flip0 == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6202
			pIlc = &ilc0_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6203
			flip0 = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6204
			last0_0 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6205
		    } else if (flip0 == 1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6206
			pIlc = &ilc0_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6207
			flip0 = 2;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6208
			last0_1 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6209
		    } else if (flip0 == 2) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6210
			pIlc = &ilc0_2;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6211
			flip0 = 3;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6212
			last0_2 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6213
		    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6214
			pIlc = &ilc0_3;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6215
			flip0 = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6216
			last0_3 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6217
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6218
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6219
		    pIlc->ilc_func = __SEND0ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6220
		    if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6221
			__flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6222
			pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6223
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6224
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6225
		RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6226
	    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6227
		static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6228
		RETURN (_SEND0(self, aSelector, nil, &ilc0));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6229
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6230
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6231
	case 1:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6232
	    if (InterruptPending == nil) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6233
		static OBJ last1_0 = nil; static struct inlineCache ilc1_0 = __ILCPERF1(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6234
		static OBJ last1_1 = nil; static struct inlineCache ilc1_1 = __ILCPERF1(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6235
		static OBJ last1_2 = nil; static struct inlineCache ilc1_2 = __ILCPERF1(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6236
		static OBJ last1_3 = nil; static struct inlineCache ilc1_3 = __ILCPERF1(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6237
		static int flip1 = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6238
		struct inlineCache *pIlc;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6239
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6240
		if (aSelector == last1_0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6241
		    pIlc = &ilc1_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6242
		} else if (aSelector == last1_1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6243
		    pIlc = &ilc1_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6244
		} else if (aSelector == last1_2) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6245
		    pIlc = &ilc1_2;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6246
		} else if (aSelector == last1_3) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6247
		    pIlc = &ilc1_3;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6248
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6249
		    if (flip1 == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6250
			pIlc = &ilc1_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6251
			flip1 = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6252
			last1_0 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6253
		    } else if (flip1 == 1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6254
			pIlc = &ilc1_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6255
			flip1 = 2;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6256
			last1_1 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6257
		    } else if (flip1 == 2) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6258
			pIlc = &ilc1_2;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6259
			flip1 = 3;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6260
			last1_2 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6261
		    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6262
			pIlc = &ilc1_3;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6263
			flip1 = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6264
			last1_3 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6265
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6266
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6267
		    pIlc->ilc_func = __SEND1ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6268
		    if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6269
			__flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6270
			pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6271
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6272
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6273
		RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6274
	    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6275
		static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6276
		RETURN (_SEND1(self, aSelector, nil, &ilc1, argP[0]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6277
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6278
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6279
	case 2:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6280
	    if (InterruptPending == nil) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6281
		static OBJ last2_0 = nil; static struct inlineCache ilc2_0 = __ILCPERF2(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6282
		static OBJ last2_1 = nil; static struct inlineCache ilc2_1 = __ILCPERF2(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6283
		static int flip2 = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6284
		struct inlineCache *pIlc;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6285
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6286
		if (aSelector == last2_0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6287
		    pIlc = &ilc2_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6288
		} else if (aSelector == last2_1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6289
		    pIlc = &ilc2_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6290
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6291
		    if (flip2 == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6292
			pIlc = &ilc2_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6293
			flip2 = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6294
			last2_0 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6295
		    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6296
			pIlc = &ilc2_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6297
			flip2 = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6298
			last2_1 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6299
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6300
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6301
		    pIlc->ilc_func = __SEND2ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6302
		    if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6303
			__flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6304
			pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6305
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6306
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6307
		RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6308
	    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6309
		static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6310
		RETURN (_SEND2(self, aSelector, nil, &ilc2, argP[0], argP[1]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6311
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6312
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6313
	case 3:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6314
	    if (InterruptPending == nil) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6315
		static OBJ last3_0 = nil; static struct inlineCache ilc3_0 = __ILCPERF3(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6316
		static OBJ last3_1 = nil; static struct inlineCache ilc3_1 = __ILCPERF3(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6317
		static int flip3 = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6318
		struct inlineCache *pIlc;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6319
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6320
		if (aSelector == last3_0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6321
		    pIlc = &ilc3_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6322
		} else if (aSelector == last3_1) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6323
		    pIlc = &ilc3_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6324
		} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6325
		    if (flip3 == 0) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6326
			pIlc = &ilc3_0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6327
			flip3 = 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6328
			last3_0 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6329
		    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6330
			pIlc = &ilc3_1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6331
			flip3 = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6332
			last3_1 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6333
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6334
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6335
		    pIlc->ilc_func = __SEND3ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6336
		    if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6337
			__flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6338
			pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6339
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6340
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6341
		RETURN ((*pIlc->ilc_func)(self, aSelector, nil, pIlc, argP[0], argP[1], argP[2]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6342
	    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6343
		static struct inlineCache ilc3 = __DUMMYILCSELF3(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6344
		RETURN (_SEND3(self, aSelector, nil, &ilc3, argP[0], argP[1], argP[2]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6345
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6346
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6347
	case 4:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6348
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6349
		static OBJ last4 = nil; static struct inlineCache ilc4 = __ILCPERF4(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6350
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6351
		if ((InterruptPending != nil) || (aSelector != last4)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6352
		    ilc4.ilc_func = __SEND4ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6353
		    if (ilc4.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6354
			__flushPolyCache(ilc4.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6355
			ilc4.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6356
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6357
		    last4 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6358
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6359
		RETURN ( (*ilc4.ilc_func)(self, aSelector, nil, &ilc4,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6360
						argP[0], argP[1], argP[2], argP[3]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6361
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6362
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6363
	case 5:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6364
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6365
		static OBJ last5 = nil; static struct inlineCache ilc5 = __ILCPERF5(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6366
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6367
		if ((InterruptPending != nil) || (aSelector != last5)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6368
		    ilc5.ilc_func = __SEND5ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6369
		    if (ilc5.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6370
			__flushPolyCache(ilc5.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6371
			ilc5.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6372
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6373
		    last5 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6374
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6375
		RETURN ( (*ilc5.ilc_func)(self, aSelector, nil, &ilc5,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6376
						argP[0], argP[1], argP[2], argP[3], argP[4]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6377
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6378
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6379
	case 6:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6380
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6381
		static OBJ last6 = nil; static struct inlineCache ilc6 = __ILCPERF6(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6382
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6383
		if ((InterruptPending != nil) || (aSelector != last6)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6384
		    ilc6.ilc_func = __SEND6ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6385
		    if (ilc6.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6386
			__flushPolyCache(ilc6.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6387
			ilc6.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6388
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6389
		    last6 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6390
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6391
		RETURN ( (*ilc6.ilc_func)(self, aSelector, nil, &ilc6,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6392
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6393
						argP[5]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6394
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6395
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6396
	case 7:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6397
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6398
		static OBJ last7 = nil; static struct inlineCache ilc7 = __ILCPERF7(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6399
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6400
		if ((InterruptPending != nil) || (aSelector != last7)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6401
		    ilc7.ilc_func = __SEND7ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6402
		    if (ilc7.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6403
			__flushPolyCache(ilc7.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6404
			ilc7.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6405
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6406
		    last7 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6407
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6408
		RETURN ( (*ilc7.ilc_func)(self, aSelector, nil, &ilc7,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6409
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6410
						argP[5], argP[6]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6411
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6412
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6413
	case 8:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6414
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6415
		static OBJ last8 = nil; static struct inlineCache ilc8 = __ILCPERF8(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6416
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6417
		if ((InterruptPending != nil) || (aSelector != last8)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6418
		    ilc8.ilc_func = __SEND8ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6419
		    if (ilc8.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6420
			__flushPolyCache(ilc8.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6421
			ilc8.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6422
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6423
		    last8 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6424
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6425
		RETURN ( (*ilc8.ilc_func)(self, aSelector, nil, &ilc8,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6426
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6427
						argP[5], argP[6], argP[7]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6428
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6429
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6430
	case 9:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6431
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6432
		static OBJ last9 = nil; static struct inlineCache ilc9 = __ILCPERF9(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6433
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6434
		if ((InterruptPending != nil) || (aSelector != last9)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6435
		    ilc9.ilc_func = __SEND9ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6436
		    if (ilc9.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6437
			__flushPolyCache(ilc9.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6438
			ilc9.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6439
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6440
		    last9 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6441
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6442
		RETURN ( (*ilc9.ilc_func)(self, aSelector, nil, &ilc9,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6443
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6444
						argP[5], argP[6], argP[7], argP[8]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6445
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6446
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6447
	case 10:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6448
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6449
		static OBJ last10 = nil; static struct inlineCache ilc10 = __ILCPERF10(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6450
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6451
		if ((InterruptPending != nil) || (aSelector != last10)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6452
		    ilc10.ilc_func = __SEND10ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6453
		    if (ilc10.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6454
			__flushPolyCache(ilc10.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6455
			ilc10.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6456
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6457
		    last10 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6458
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6459
		RETURN ( (*ilc10.ilc_func)(self, aSelector, nil, &ilc10,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6460
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6461
						argP[5], argP[6], argP[7], argP[8], argP[9]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6462
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6463
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6464
	case 11:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6465
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6466
		static OBJ last11 = nil; static struct inlineCache ilc11 = __ILCPERF11(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6467
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6468
		if ((InterruptPending != nil) || (aSelector != last11)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6469
		    ilc11.ilc_func = __SEND11ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6470
		    if (ilc11.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6471
			__flushPolyCache(ilc11.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6472
			ilc11.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6473
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6474
		    last11 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6475
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6476
		RETURN ( (*ilc11.ilc_func)(self, aSelector, nil, &ilc11,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6477
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6478
						argP[5], argP[6], argP[7], argP[8], argP[9],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6479
						argP[10]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6480
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6481
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6482
	case 12:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6483
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6484
		static OBJ last12 = nil; static struct inlineCache ilc12 = __ILCPERF12(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6485
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6486
		if ((InterruptPending != nil) || (aSelector != last12)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6487
		    ilc12.ilc_func = __SEND12ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6488
		    if (ilc12.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6489
			__flushPolyCache(ilc12.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6490
			ilc12.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6491
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6492
		    last12 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6493
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6494
		RETURN ( (*ilc12.ilc_func)(self, aSelector, nil, &ilc12,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6495
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6496
						argP[5], argP[6], argP[7], argP[8], argP[9],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6497
						argP[10], argP[11]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6498
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6499
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6500
	case 13:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6501
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6502
		static OBJ last13 = nil; static struct inlineCache ilc13 = __ILCPERF13(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6503
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6504
		if ((InterruptPending != nil) || (aSelector != last13)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6505
		    ilc13.ilc_func = __SEND13ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6506
		    if (ilc13.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6507
			__flushPolyCache(ilc13.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6508
			ilc13.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6509
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6510
		    last13 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6511
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6512
		RETURN ( (*ilc13.ilc_func)(self, aSelector, nil, &ilc13,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6513
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6514
						argP[5], argP[6], argP[7], argP[8], argP[9],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6515
						argP[10], argP[11], argP[12]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6516
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6517
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6518
	case 14:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6519
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6520
		static OBJ last14 = nil; static struct inlineCache ilc14 = __ILCPERF14(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6521
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6522
		if ((InterruptPending != nil) || (aSelector != last14)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6523
		    ilc14.ilc_func = __SEND14ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6524
		    if (ilc14.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6525
			__flushPolyCache(ilc14.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6526
			ilc14.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6527
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6528
		    last14 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6529
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6530
		RETURN ( (*ilc14.ilc_func)(self, aSelector, nil, &ilc14,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6531
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6532
						argP[5], argP[6], argP[7], argP[8], argP[9],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6533
						argP[10], argP[11], argP[12], argP[13]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6534
	    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6535
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6536
	case 15:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6537
	    {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6538
		static OBJ last15 = nil; static struct inlineCache ilc15 = __ILCPERF15(@line);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6539
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6540
		if ((InterruptPending != nil) || (aSelector != last15)) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6541
		    ilc15.ilc_func = __SEND15ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6542
		    if (ilc15.ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6543
			__flushPolyCache(ilc15.ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6544
			ilc15.ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6545
		    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6546
		    last15 = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6547
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6548
		RETURN ( (*ilc15.ilc_func)(self, aSelector, nil, &ilc15,
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6549
						argP[0], argP[1], argP[2], argP[3], argP[4],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6550
						argP[5], argP[6], argP[7], argP[8], argP[9],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6551
						argP[10], argP[11], argP[12], argP[13],
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6552
						argP[14]));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6553
	    }
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6554
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6555
bad:;
18238
0b3b5ced099d oops - sorry
Claus Gittinger <cg@exept.de>
parents: 18231
diff changeset
  6556
#endif
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6559
    "/ arrive here, if bad number of arguments (too many)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6560
    "/ ST/X (currently) only allows up to 15 method arguments
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6561
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6562
    ^ self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6563
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6564
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6565
perform:aSelector withOptionalArgument:arg
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6566
    "send aSelector-message to the receiver.
6318
3677d346113a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6316
diff changeset
  6567
     If the message expects an argument, pass arg."
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6568
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  6569
    aSelector argumentCount == 1 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6570
	^ self perform:aSelector with:arg
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6571
    ].
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6572
    ^ self perform:aSelector
6319
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6573
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6574
    "
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6575
     |rec sel|
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6576
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6577
     rec := -1.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6578
     sel := #abs.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6579
     rec perform:sel withOptionalArgument:2.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6580
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6581
     sel := #max:.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6582
     rec perform:sel withOptionalArgument:2.
75252ef51b38 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6318
diff changeset
  6583
    "
6316
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6584
!
345f36d2fc65 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6263
diff changeset
  6585
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6586
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6587
    "send aSelector-message to the receiver.
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6588
     Depending on the number of arguments the message expects,
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6589
     pass either none, 1, or 2 arguments."
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6590
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6591
    |numArgs|
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6592
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  6593
    numArgs := aSelector argumentCount.
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6594
    numArgs == 0 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6595
	^ self perform:aSelector
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6596
    ].
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6597
    numArgs == 1 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6598
	^ self perform:aSelector with:optionalArg1
6321
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6599
    ].
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6600
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6601
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6602
    "
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6603
     |rec sel|
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6604
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6605
     rec := -1.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6606
     sel := #abs.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6607
     rec perform:sel withOptionalArgument:2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6608
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6609
     sel := #max:.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6610
     rec perform:sel withOptionalArgument:2.
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6611
    "
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6612
!
8af99331b6e8 #perform:withOptionalArgument:and:
Claus Gittinger <cg@exept.de>
parents: 6319
diff changeset
  6613
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6614
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2 and:optionalArg3
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6615
    "send aSelector-message to the receiver.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6616
     Depending on the number of arguments the message expects,
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6617
     pass either none, 1, 2 or 3 arguments."
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6618
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6619
    |numArgs|
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6620
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  6621
    numArgs := aSelector argumentCount.
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6622
    numArgs == 0 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6623
	^ self perform:aSelector
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6624
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6625
    numArgs == 1 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6626
	^ self perform:aSelector with:optionalArg1
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6627
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6628
    numArgs == 2 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6629
	^ self perform:aSelector with:optionalArg1 with:optionalArg2
6728
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6630
    ].
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6631
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6632
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6633
    "
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6634
     |rec sel|
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6635
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6636
     rec := -1.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6637
     sel := #abs.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6638
     rec perform:sel withOptionalArgument:2.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6639
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6640
     sel := #max:.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6641
     rec perform:sel withOptionalArgument:2.
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6642
    "
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6643
!
a4fc441779dc with 3 OptionalArguments
Claus Gittinger <cg@exept.de>
parents: 6721
diff changeset
  6644
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6645
perform:aSelector withOptionalArgument:optionalArg1 and:optionalArg2 and:optionalArg3 and:optionalArg4
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6646
    "send aSelector-message to the receiver.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6647
     Depending on the number of arguments the message expects,
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6648
     pass either none, 1, 2, 3 or 4 arguments."
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6649
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6650
    |numArgs|
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6651
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  6652
    numArgs := aSelector argumentCount.
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6653
    numArgs == 0 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6654
	^ self perform:aSelector
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6655
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6656
    numArgs == 1 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6657
	^ self perform:aSelector with:optionalArg1
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6658
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6659
    numArgs == 2 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6660
	^ self perform:aSelector with:optionalArg1 with:optionalArg2
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6661
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6662
    numArgs == 3 ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  6663
	^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6664
    ].
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6665
    ^ self perform:aSelector with:optionalArg1 with:optionalArg2 with:optionalArg3 with:optionalArg4.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6666
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6667
    "
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6668
     |rec sel|
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6669
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6670
     rec := -1.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6671
     sel := #abs.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6672
     rec perform:sel withOptionalArgument:2.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6673
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6674
     sel := #max:.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6675
     rec perform:sel withOptionalArgument:2.
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6676
    "
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6677
!
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
  6678
17524
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6679
performMessage:aMessage
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6680
    "Send aMessage, an object which provides a selector and arguments to the
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6681
     receiver object.
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6682
     Added for Ansi compatibility"
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6683
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6684
    ^ self perform:(aMessage selector) withArguments:(aMessage arguments).
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6685
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6686
    "
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6687
     123 performMessage:(Message selector:#+ argument:100)
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6688
    "
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6689
!
4a059f9d1dee class: Object
Claus Gittinger <cg@exept.de>
parents: 17456
diff changeset
  6690
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6691
performMethod:aMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6692
    "invoke aMethod on the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6693
     The method should be a zero-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6694
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6695
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6696
     Warning:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6697
	 Take care for the method to be appropriate for the
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6698
	 receiver - no checking is done by the VM."
5755
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
    ^ aMethod valueWithReceiver:self arguments:#()
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
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6704
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6705
     mthd := SmallInteger compiledMethodAt:#negated.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6706
     Transcript showCR:(1 performMethod:mthd)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6707
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6708
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6709
    "BAD USE example:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6710
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6711
     |mthd|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6712
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6713
     mthd := Point compiledMethodAt:#x.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6714
     Transcript showCR:((1->2) performMethod:mthd)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6715
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6716
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6717
    "Modified: 31.7.1997 / 17:41:50 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6718
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6719
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6720
performMethod:aMethod arguments:argumentArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6721
    "invoke aMethod on the receiver, passing an argumentArray.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6722
     The size of the argumentArray should match the number of args
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6723
     expected by the method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6724
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6725
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6726
     Warning:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6727
	 Take care for the method to be appropriate for the
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6728
	 receiver - no checking is done by the VM."
5755
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
    ^ aMethod valueWithReceiver:self arguments:argumentArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6731
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6732
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6733
     |mthd|
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
     mthd := SmallInteger compiledMethodAt:#+.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6736
     Transcript showCR:(1 performMethod:mthd arguments:#(2))
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6739
    "Created: 31.7.1997 / 17:46:31 / cg"
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
performMethod:aMethod with:arg
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6743
    "invoke aMethod on the receiver, passing an argument.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6744
     The method should be a one-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6745
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6746
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6747
     Warning:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6748
	 Take care for the method to be appropriate for the
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6749
	 receiver - no checking is done by the VM."
5755
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
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg)
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6754
     |mthd|
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
     mthd := SmallInteger compiledMethodAt:#+.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6757
     Transcript showCR:(1 performMethod:mthd with:2)
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6760
    "Modified: 31.7.1997 / 17:42:32 / cg"
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
performMethod:aMethod with:arg1 with:arg2
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6764
    "invoke aMethod on the receiver, passing two arguments.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6765
     The method should be a two-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6766
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6767
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6768
     Warning:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6769
	 Take care for the method to be appropriate for the
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6770
	 receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6771
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6772
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2)
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
     |mthd arr|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6776
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6777
     arr := Array new:1.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6778
     mthd := Array compiledMethodAt:#basicAt:put:.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6779
     arr performMethod:mthd with:1 with:'foo'.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6780
     Transcript showCR:arr
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6783
    "Modified: 31.7.1997 / 17:44:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6784
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6785
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6786
performMethod:aMethod with:arg1 with:arg2 with:arg3
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6787
    "invoke aMethod on the receiver, passing three arguments.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6788
     The method should be a three-argument method.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6789
     This is a non-object-oriented entry, applying a method
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6790
     in a functional way on a receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6791
     Warning:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6792
	 Take care for the method to be appropriate for the
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6793
	 receiver - no checking is done by the VM."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6794
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6795
    ^ aMethod valueWithReceiver:self arguments:(Array with:arg1 with:arg2 with:arg3)
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
    "Created: 31.7.1997 / 17:45:20 / cg"
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6798
!
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6799
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6800
performX:aSelector
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  6801
    "send the message aSelector to the receiver
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  6802
     This is the original implementation of #perform, for reference (before Jan's changes for Ruby tuning)."
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6803
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6804
    <resource: #skipInDebuggersWalkBack>
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6805
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6806
%{
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6807
    REGISTER OBJ sel = aSelector;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6808
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6809
    if (InterruptPending == nil) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6810
	struct inlineCache *pIlc;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6811
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6812
#define SEL_AND_ILC_INIT_1(l)   { nil , __ILCPERF0(l) }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6813
#define SEL_AND_ILC_INIT_2(l)   SEL_AND_ILC_INIT_1(l)   , SEL_AND_ILC_INIT_1(l)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6814
#define SEL_AND_ILC_INIT_4(l)   SEL_AND_ILC_INIT_2(l)   , SEL_AND_ILC_INIT_2(l)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6815
#define SEL_AND_ILC_INIT_8(l)   SEL_AND_ILC_INIT_4(l)   , SEL_AND_ILC_INIT_4(l)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6816
#define SEL_AND_ILC_INIT_16(l)  SEL_AND_ILC_INIT_8(l)   , SEL_AND_ILC_INIT_8(l)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6817
#define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6818
#define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6819
#define SEL_AND_ILC_INIT_64(l)  SEL_AND_ILC_INIT_32(l)  , SEL_AND_ILC_INIT_32(l)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6820
#define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l)  , SEL_AND_ILC_INIT_64(l)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6821
#define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
16230
e5de942a1a19 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 16229
diff changeset
  6822
#undef nilcs
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6823
#define nilcs 256
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6824
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6825
	static struct sel_and_ilc {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6826
	    OBJ sel;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6827
	    struct inlineCache ilc;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6828
	    struct sel_and_ilc *next;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6829
	} sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) };
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6830
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6831
#undef SEL_AND_ILC_INIT_1
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6832
#undef SEL_AND_ILC_INIT_2
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6833
#undef SEL_AND_ILC_INIT_4
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6834
#undef SEL_AND_ILC_INIT_8
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6835
#undef SEL_AND_ILC_INIT_16
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6836
#undef SEL_AND_ILC_INIT_32
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6837
#undef SEL_AND_ILC_INIT_64
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6838
#undef SEL_AND_ILC_INIT_128
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6839
#undef SEL_AND_ILC_INIT_256
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6840
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6841
	static struct sel_and_ilc *nextFree = sel_and_ilc;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6842
	static struct sel_and_ilc *lastUsed = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6843
	int n;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6844
	struct sel_and_ilc *slot, *prev, *prevPrev;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6845
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6846
	for (n=0, slot = lastUsed, prev = prevPrev = 0; slot; n++, slot = slot->next) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6847
	   if (sel == slot->sel) {
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  6848
#ifdef XXDEBUG
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6849
printf("cached slot %d (len=%d)\n", slot-sel_and_ilc, n);
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  6850
#endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6851
		pIlc = &(slot->ilc);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6852
		// move to front
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6853
		if (prev) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6854
		    prev->next = slot->next;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6855
		}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6856
		slot->next = lastUsed;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6857
		lastUsed = slot;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6858
		pIlc = &(slot->ilc);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6859
		goto perform0_send_and_return;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6860
	   }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6861
	   prevPrev = prev;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6862
	   prev = slot;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6863
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6864
	// not recently used...
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6865
	if (nextFree) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6866
	    // another free one
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6867
	    slot = nextFree;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6868
	    nextFree = nextFree + 1;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6869
	    if (nextFree >= &(sel_and_ilc[nilcs])) nextFree = 0;
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  6870
#ifdef XXDEBUG
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6871
printf("new slot %d\n", slot-sel_and_ilc);
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  6872
#endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6873
	} else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6874
	    // no more for reuse - use least recently used
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6875
	    slot = prev;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6876
	    prevPrev->next = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6877
	    slot->next = lastUsed;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6878
	    lastUsed = slot;
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  6879
#ifdef XXDEBUG
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6880
printf("reuse last slot %d\n", slot-sel_and_ilc);
15942
a76da2251215 handle weak objects (with instances or non-WeakArray)
Claus Gittinger <cg@exept.de>
parents: 15932
diff changeset
  6881
#endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6882
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6883
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6884
	/*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6885
	pIlc = &(slot->ilc);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6886
	slot->sel = sel;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6887
	pIlc->ilc_func = __SEND0ADDR__;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6888
	if (pIlc->ilc_poly) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6889
	     __flushPolyCache(pIlc->ilc_poly);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6890
	    pIlc->ilc_poly = 0;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6891
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6892
perform0_send_and_return:
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6893
	RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6894
    } else {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6895
	static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6896
	RETURN (_SEND0(self, aSelector, nil, &ilc0));
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6897
    }
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6898
%}.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6899
    ^ self perform:aSelector withArguments:#()
15797
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6900
!
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6901
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6902
returnablePerform:aSelector with:arg
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6903
    "send the one-arg-message aSelector to the receiver.
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6904
     This is the same as #perform:with: but the context can return."
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6905
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6906
    <context: #return>
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6907
%{
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6908
    REGISTER OBJ sel = aSelector;
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6909
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6910
    if (InterruptPending == nil) {
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6911
	struct inlineCache *pIlc;
15797
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6912
    /* JV @ 2010-22-07: To improve performance I use 256 ILCs instead
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6913
       of default 4. For details, see comment in perform: */
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6914
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6915
#define SEL_AND_ILC_INIT_1(l)   { nil , __ILCPERF1(l) }
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6916
#define SEL_AND_ILC_INIT_2(l)   SEL_AND_ILC_INIT_1(l)   , SEL_AND_ILC_INIT_1(l)
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6917
#define SEL_AND_ILC_INIT_4(l)   SEL_AND_ILC_INIT_2(l)   , SEL_AND_ILC_INIT_2(l)
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6918
#define SEL_AND_ILC_INIT_8(l)   SEL_AND_ILC_INIT_4(l)   , SEL_AND_ILC_INIT_4(l)
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6919
#define SEL_AND_ILC_INIT_16(l)  SEL_AND_ILC_INIT_8(l)   , SEL_AND_ILC_INIT_8(l)
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6920
#define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6921
#define SEL_AND_ILC_INIT_32(l)  SEL_AND_ILC_INIT_16(l)  , SEL_AND_ILC_INIT_16(l)
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6922
#define SEL_AND_ILC_INIT_64(l)  SEL_AND_ILC_INIT_32(l)  , SEL_AND_ILC_INIT_32(l)
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6923
#define SEL_AND_ILC_INIT_128(l) SEL_AND_ILC_INIT_64(l)  , SEL_AND_ILC_INIT_64(l)
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6924
#define SEL_AND_ILC_INIT_256(l) SEL_AND_ILC_INIT_128(l) , SEL_AND_ILC_INIT_128(l)
16230
e5de942a1a19 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 16229
diff changeset
  6925
#undef nilcs
15797
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6926
#define nilcs 256
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6927
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6928
	static struct { OBJ sel; struct inlineCache ilc; } sel_and_ilc[nilcs] = { SEL_AND_ILC_INIT_256(29) };
15797
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6929
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6930
#undef SEL_AND_ILC_INIT_1
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6931
#undef SEL_AND_ILC_INIT_2
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6932
#undef SEL_AND_ILC_INIT_4
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6933
#undef SEL_AND_ILC_INIT_8
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6934
#undef SEL_AND_ILC_INIT_16
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6935
#undef SEL_AND_ILC_INIT_32
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6936
#undef SEL_AND_ILC_INIT_64
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6937
#undef SEL_AND_ILC_INIT_128
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6938
#undef SEL_AND_ILC_INIT_256
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6939
18185
f454e3590ebc missing type in flip
Claus Gittinger <cg@exept.de>
parents: 18151
diff changeset
  6940
	static int flip = 0;
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6941
	int i;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6942
	for (i = 0; i < nilcs; i++) {
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6943
	   if (sel == sel_and_ilc[i].sel) {
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6944
		pIlc = &sel_and_ilc[i].ilc;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6945
		goto perform1_send_and_return;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6946
	   }
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6947
	}
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6948
	/*printf("Object >> #perform: #%s with: arg --> no PIC found\n", __symbolVal(aSelector));*/
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6949
	pIlc = &sel_and_ilc[flip].ilc;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6950
	sel_and_ilc[flip].sel = sel;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6951
	flip = (flip + 1) % nilcs;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6952
	pIlc->ilc_func = __SEND1ADDR__;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6953
	if (pIlc->ilc_poly) {
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6954
	     __flushPolyCache(pIlc->ilc_poly);
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6955
	    pIlc->ilc_poly = 0;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6956
	}
15797
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6957
perform1_send_and_return:
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6958
	RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) );
15797
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6959
    } else {
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6960
	static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1);
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  6961
	RETURN (_SEND1(self, aSelector, nil, &ilc1, arg));
15797
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6962
    }
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6963
%}.
4100230d57fa class: Object
Stefan Vogel <sv@exept.de>
parents: 15777
diff changeset
  6964
    ^ self perform:aSelector withArguments:(Array with:arg)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6965
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  6966
17677
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6967
!Object methodsFor:'misc ui support'!
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6968
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6969
browse
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6970
    "open a browser on the receiver's class"
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6971
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6972
    self class theNonMetaclass browse
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6973
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6974
    "
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6975
     10 browse
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6976
     Collection browse
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6977
     Collection class browse
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6978
    "
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6979
! !
4b68c0b48d73 class: Object
Claus Gittinger <cg@exept.de>
parents: 17590
diff changeset
  6980
10834
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6981
!Object methodsFor:'object persistency'!
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6982
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6983
elementDescriptorFor:anAspectSymbol
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6984
    "support for persistency:
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6985
     answer a collection of associations containing the
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6986
     objects state to be encoded for aspect.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6987
     Association key is the instance variable name or access selector,
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6988
     association value is the contents of the instance variable.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6989
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6990
     The default is to return the contents of all non-nil instance variables"
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6991
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6992
    |ret|
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6993
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6994
    ret := 0.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6995
    anAspectSymbol notNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6996
	ret := self perform:anAspectSymbol ifNotUnderstood:[0].
10834
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6997
    ].
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  6998
    ret == 0 ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  6999
	^ self elementDescriptorForNonNilInstanceVariables
10834
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7000
    ].
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7001
    ^ ret.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7002
!
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7003
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7004
elementDescriptorForInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7005
    "return all instance variables for visiting/encoding"
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7006
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7007
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | true].
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7008
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7009
    "
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7010
      #(1 2 3 nil true symbol) elementDescriptorForInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7011
      Dictionary new elementDescriptorForInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7012
      (5 @ nil) elementDescriptorForInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7013
    "
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7014
!
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7015
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7016
elementDescriptorForInstanceVariablesMatching:aBlock
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7017
    "return all instance variables which conform to aBlock, for encoding/visiting.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7018
     Indexed vars are all included."
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7019
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7020
    |instVarNames theClass children
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7021
     instSize "{ Class: SmallInteger }"
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7022
     varSize "{ Class: SmallInteger }"|
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7023
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7024
    theClass := self class.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7025
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7026
    instSize := theClass instSize.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7027
    varSize := theClass isVariable ifTrue:[self basicSize] ifFalse:[0].
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7028
    children := OrderedCollection new:(instSize + varSize).
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7029
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7030
    instVarNames := theClass allInstVarNames.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7031
    1 to:instSize do:[:i | |var|
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7032
	var := self instVarAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7033
	(aBlock value:var) ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7034
	    children add:((instVarNames at:i) -> var)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7035
	]
10834
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7036
    ].
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7037
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7038
    varSize ~~ 0 ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7039
	1 to:varSize do:[:i |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7040
	    children add:(i -> (self basicAt:i))
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7041
	]
10834
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7042
    ].
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7043
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7044
    ^ children.
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7045
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7046
    "
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7047
      #(1 2 3 nil true symbol) elementDescriptorForInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7048
      Dictionary new elementDescriptorForInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7049
      (5 @ nil) elementDescriptorForInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7050
    "
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7051
!
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7052
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7053
elementDescriptorForNonNilInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7054
    "return all non-nil instance variables for visiting/encoding"
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7055
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7056
    ^ self elementDescriptorForInstanceVariablesMatching:[:val | val notNil].
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7057
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7058
    "
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7059
      #(1 2 3 nil true symbol) elementDescriptorForNonNilInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7060
      Dictionary new elementDescriptorForNonNilInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7061
      (5 @ nil) elementDescriptorForNonNilInstanceVariables
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7062
    "
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7063
! !
f780552c1b11 category change
Claus Gittinger <cg@exept.de>
parents: 10732
diff changeset
  7064
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7065
!Object methodsFor:'printing & storing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7066
6235
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7067
basicPrintOn:aStream
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7068
    "append the receivers className with an articel to the argument, aStream"
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7069
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7070
    aStream nextPutAll:self classNameWithArticle
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7071
!
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7072
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7073
className
14368
deb662b4664b comment/format in: #className
Claus Gittinger <cg@exept.de>
parents: 14355
diff changeset
  7074
    "return the classname of the receiver's class"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7075
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7076
    ^ self class name
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
     1 className
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7080
     1 class className
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7081
     $a className
9105
1666cb465e3f comments
Stefan Vogel <sv@exept.de>
parents: 9071
diff changeset
  7082
     $a class className
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7083
    "
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7086
classNameWithArticle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7087
    "return a string consisting of classname preceeded by an article.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7088
     (dont expect me to write national variants for this ... :-)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7089
     If you have special preferences, redefine it ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7090
6829
db28715efb4d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6815
diff changeset
  7091
    | cls|
5755
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
    (cls := self class) == self ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7094
	^ 'a funny object'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7095
    ].
14368
deb662b4664b comment/format in: #className
Claus Gittinger <cg@exept.de>
parents: 14355
diff changeset
  7096
    cls isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7097
	^ 'a nil-classes object'        "/ cannot happen
14368
deb662b4664b comment/format in: #className
Claus Gittinger <cg@exept.de>
parents: 14355
diff changeset
  7098
    ].
6829
db28715efb4d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6815
diff changeset
  7099
    ^ cls nameWithArticle
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7100
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7101
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7102
     1 classNameWithArticle
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7103
     (1->2) classNameWithArticle
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7104
     XWorkstation basicNew classNameWithArticle
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7105
     XWorkstation classNameWithArticle
5755
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7108
    "Modified: 13.5.1996 / 12:16:14 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7109
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7110
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7111
errorPrint
12703
b87cc4993193 changed:
sr
parents: 12566
diff changeset
  7112
    "print the receiver on the Transcript and Stderr.
10530
0f3d3ddd3837 #errorPrint* and #infoPrint* print to Transcript.
Stefan Vogel <sv@exept.de>
parents: 10527
diff changeset
  7113
     The Transcript is directed to the standard error stream on
0f3d3ddd3837 #errorPrint* and #infoPrint* print to Transcript.
Stefan Vogel <sv@exept.de>
parents: 10527
diff changeset
  7114
     headless applications."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7115
14165
b5bb4e9fde8c changed:
Stefan Vogel <sv@exept.de>
parents: 14162
diff changeset
  7116
    Stderr isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7117
	"/ the following allows errorPrint to be used during
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7118
	"/ the early init-phase, when no Stderr has been set up.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7119
	"/ (depends on string to respond to #errorPrint)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7120
	self printString utf8Encoded errorPrint.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7121
	^ self.
14165
b5bb4e9fde8c changed:
Stefan Vogel <sv@exept.de>
parents: 14162
diff changeset
  7122
    ].
b5bb4e9fde8c changed:
Stefan Vogel <sv@exept.de>
parents: 14162
diff changeset
  7123
13350
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7124
    self withErrorStreamDo:[:s | self printOn:s].
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7125
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7126
    "Modified: / 21-04-2011 / 12:46:42 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7127
!
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
errorPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7130
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7131
12703
b87cc4993193 changed:
sr
parents: 12566
diff changeset
  7132
    "print the receiver followed by a cr on the error stream(s).
10530
0f3d3ddd3837 #errorPrint* and #infoPrint* print to Transcript.
Stefan Vogel <sv@exept.de>
parents: 10527
diff changeset
  7133
     The Transcript is directed to the standard error stream on
0f3d3ddd3837 #errorPrint* and #infoPrint* print to Transcript.
Stefan Vogel <sv@exept.de>
parents: 10527
diff changeset
  7134
     headless applications."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7135
14165
b5bb4e9fde8c changed:
Stefan Vogel <sv@exept.de>
parents: 14162
diff changeset
  7136
    Stderr isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7137
	"/ the following allows errorPrintCR to be used during
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7138
	"/ the early init-phase, when no Stderr has been set up.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7139
	"/ (depends on string to respond to #errorPrintCR)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7140
	self printString utf8Encoded errorPrintCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7141
	^ self.
14165
b5bb4e9fde8c changed:
Stefan Vogel <sv@exept.de>
parents: 14162
diff changeset
  7142
    ].
b5bb4e9fde8c changed:
Stefan Vogel <sv@exept.de>
parents: 14162
diff changeset
  7143
13350
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7144
    self withErrorStreamDo:[:s | self printOn:s. s cr].
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7145
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7146
    "
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7147
     'hello' errorPrintCR
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7148
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7149
10564
7d25403688ba dont errorPrint on Transcript when I am a system process.
Claus Gittinger <cg@exept.de>
parents: 10558
diff changeset
  7150
    "Created: / 20-05-1996 / 10:20:41 / cg"
13350
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7151
    "Modified: / 21-04-2011 / 12:47:13 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7152
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7153
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7154
errorPrintNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7155
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7156
    <resource:#obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7157
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7158
    "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
  7159
     Please use #errorPrintCR - this method exists for backward compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7160
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7161
    ^ self errorPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7162
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7163
    "Modified: 20.5.1996 / 10:24:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7164
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7165
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7166
errorPrintNewline
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7167
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7168
    <resource:#obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7169
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7170
    "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
  7171
     Please use #errorPrintCR - this method exists for backward compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7172
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7173
    self errorPrintCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7174
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7175
    "Modified: 20.5.1996 / 10:24:38 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7176
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7177
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7178
infoPrint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7179
    "{ Pragma: +optSpace }"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7180
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7181
    "print the receiver on the standard error stream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7182
     This is meant for information messages which are not warnings
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7183
     or fatal messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7184
     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
  7185
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7186
    InfoPrinting == true ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7187
	self errorPrint
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7188
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7189
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7190
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7191
infoPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7192
    "{ Pragma: +optSpace }"
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
    "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
  7195
     This is meant for information messages which are not warnings
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7196
     or fatal messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7197
     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
  7198
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7199
    InfoPrinting == true ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7200
	self errorPrintCR
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7201
    ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7202
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7203
    "Created: 20.5.1996 / 10:21:28 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7204
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7205
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7206
infoPrintNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7207
    "{ Pragma: +optSpace }"
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7208
    <resource:#obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7209
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7210
    "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
  7211
     Please use #infoPrintCR - this method exists for backward compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7212
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7213
    ^ self infoPrintCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7214
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7215
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7216
print
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7217
    "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
  7218
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7219
    "/ the following allows printCR to be used during
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7220
    "/ the early init-phase, when no Stdout has been set up.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7221
    "/ (depends on string to respond to #print)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7222
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7223
    Stdout isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7224
	self printString utf8Encoded print.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7225
	^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7226
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7227
    self printOn:Stdout
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
    "Modified: 4.11.1996 / 23:36:58 / cg"
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
printCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7233
    "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
  7234
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7235
    "/ the following allows printCR to be used during
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7236
    "/ the early init-phase, when no Stdout has been set up.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7237
    "/ (depends on string to respond to #printCR)
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
    Stdout isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7240
	self printString utf8Encoded printCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7241
	^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7242
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7243
    self printOn:Stdout.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7244
    Stdout cr
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
    "Created: 20.5.1996 / 10:21:37 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7247
    "Modified: 4.11.1996 / 23:37:06 / cg"
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
printNL
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7251
    "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
  7252
     This exists for GNU Smalltalk compatibility - please use #printCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7253
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7254
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7255
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7256
    ^ self printCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7257
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7258
    "Modified: 20.5.1996 / 10:25:31 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7261
printNewline
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7262
    "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
  7263
     This exists for backward compatibility - please use #printCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7264
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7265
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7266
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7267
    self printCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7268
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7269
    "Modified: 20.5.1996 / 10:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7270
!
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
printOn:aStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7273
    "append a user printed representation of the receiver to aStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7274
     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
  7275
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7276
     The default here is to output the receivers class name.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7277
     BUT: this method is heavily redefined for objects which
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7278
     can print prettier."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7279
6235
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7280
    self basicPrintOn:aStream.
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7281
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7282
   "
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7283
    (1@2) printOn:Transcript
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7284
    (1@2) basicPrintOn:Transcript
8eacf62c458e checkin from browser
Claus Gittinger <cg@exept.de>
parents: 6221
diff changeset
  7285
   "
5755
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
11068
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7288
printOn:aStream format:format
11335
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
  7289
    "this may be redefined in subclasses.
11068
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7290
     Defined here for compatibility with subclasses"
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7291
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7292
    self printOn:aStream.
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7293
!
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7294
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7295
printOn:aStream leftPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7296
    "print the receiver on aStream, padding with spaces up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7297
     padding is done on the left."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7298
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7299
    self printOn:aStream leftPaddedTo:size with:(Character space)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7300
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
     123 printOn:Transcript leftPaddedTo:10. Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7303
     123 printOn:Transcript leftPaddedTo:2. Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7304
    "
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7307
printOn:aStream leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7308
    "print the receiver on aStream, padding with padCharacters up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7309
     padding is done on the left."
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
    aStream nextPutAll:(self printStringLeftPaddedTo:size with:padCharacter)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7312
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7313
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7314
     123 printOn:Transcript leftPaddedTo:10 with:$_ . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7315
     123 printOn:Transcript leftPaddedTo:10 with:$. . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7316
    "
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7319
printOn:aStream paddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7320
    "print the receiver on aStream, padding with spaces up to size."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7321
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7322
    self printOn:aStream paddedTo:size with:(Character space)
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7325
     123.0 printOn:Transcript paddedTo:10. Transcript nextPut:$|. Transcript cr
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
printOn:aStream paddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7330
    "print the receiver on aStream, padding with padCharacter up to size"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7331
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7332
    aStream nextPutAll:(self printStringPaddedTo:size with:padCharacter).
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7335
     123 printOn:Transcript paddedTo:10 with:$_ . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7336
     123 printOn:Transcript paddedTo:10 with:$. . Transcript cr
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7337
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7338
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7339
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7340
printOn:aStream zeroPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7341
    "print the receiver on aStream, padding with zeros up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7342
     Usually used with float numbers."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7343
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7344
    self printOn:aStream paddedTo:size with:$0.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7345
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7346
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7347
     123.0 printOn:Transcript zeroPaddedTo:10
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7350
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7351
printRightAdjustLen:size
11068
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7352
    <resource: #obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7353
    "obsolete - just a name confusion.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7354
     This method will go away ..."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7355
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7356
    (self printStringLeftPaddedTo:size) printOn:Stdout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7357
!
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
printString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7360
    "return a string for printing the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7361
     Since we now use printOn: as the basic print mechanism,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7362
     we have to create a stream and print into it."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7363
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7364
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7365
11790
6dcd44bc2ff9 Larger default for #printString
Stefan Vogel <sv@exept.de>
parents: 11738
diff changeset
  7366
    s := CharacterWriteStream on:(String basicNew:40).     "allocate at least 46 bytes for fast UUID conversion"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7367
    self printOn:s.
8300
d15ead94361f Use CharacterWriteStream in #printString (speedup)
Stefan Vogel <sv@exept.de>
parents: 8287
diff changeset
  7368
    ^ s contents.
7978
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  7369
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  7370
    "
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  7371
     Date today printString.
4ce7575e1cfc care for 16bit chars in #printString
Claus Gittinger <cg@exept.de>
parents: 7838
diff changeset
  7372
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7373
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7374
11068
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7375
printStringFormat:orintFormat
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7376
    "subclasses may redefine this.
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7377
     Defined here to avoid type checks"
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7378
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7379
    ^ self printString
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7380
!
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7381
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7382
printStringLeftPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7383
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7384
     characters on the left are filled with spaces.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7385
     If the printString is longer than size,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7386
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7387
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7388
    ^ self printStringLeftPaddedTo:size with:(Character space)
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7389
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7390
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7391
     10 printStringLeftPaddedTo:10
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7392
     1 printStringLeftPaddedTo:10
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7396
printStringLeftPaddedTo:size ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7397
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7398
     characters on the left are filled with spaces.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7399
     If the printString is larger than size,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7400
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7401
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7402
    ^ self printStringLeftPaddedTo:size with:(Character space) ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7403
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7404
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7405
     12   printStringLeftPaddedTo:3 ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7406
     123  printStringLeftPaddedTo:3 ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7407
     1234 printStringLeftPaddedTo:3 ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7408
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7409
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7410
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7411
printStringLeftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7412
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7413
     characters on the left are filled with padCharacter.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7414
     If the printString is longer than size,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7415
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7416
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7417
    ^ (self printString) leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7418
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7419
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7420
     123 printStringLeftPaddedTo:10 with:$.
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7421
     1 printStringLeftPaddedTo:10 with:$.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7422
     (Float pi) printStringLeftPaddedTo:20 with:$*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7423
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7424
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7425
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7426
printStringLeftPaddedTo:size with:padCharacter ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7427
    "return my printString as a right-adjusted string of length size;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7428
     characters on the left are filled with padCharacter.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7429
     If the printString is larger than size,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7430
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7431
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7432
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7433
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7434
    s := self printString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7435
    s size > size ifTrue:[^ alternative value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7436
    ^ s leftPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7437
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7438
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7439
     12   printStringLeftPaddedTo:3 with:$. ifLarger:['***']
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7440
     123  printStringLeftPaddedTo:3 with:$. ifLarger:['***']
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7441
     1234 printStringLeftPaddedTo:3 with:$. ifLarger:['***']
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7442
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7443
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7444
8576
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7445
printStringLimitedTo:sizeLimit
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7446
    "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
  7447
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7448
    |s|
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7449
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7450
    s := CharacterWriteStream on:(String basicNew:30).
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7451
    s writeLimit:sizeLimit.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7452
    self printOn:s.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7453
    ^ s contents.
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7454
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7455
    "
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7456
     Date today printStringLimitedTo:5.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7457
     '12345678901234567890' printStringLimitedTo:5.
8576
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7458
    "
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7459
!
f58f51583a34 +printStringLimitedTo:
Claus Gittinger <cg@exept.de>
parents: 8574
diff changeset
  7460
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7461
printStringOnError:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7462
    "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
  7463
     evaluating exceptionBlock. Useful to print something in an exceptionHandler or other
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7464
     cleanup code."
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
    |rslt|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7467
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7468
    Error handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7469
	rslt := exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7470
    ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7471
	rslt := self printString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7472
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7473
    ^ rslt
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7476
printStringPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7477
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7478
     padded with spaces (at the right) up to size.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7479
     If the printString is longer than size,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7480
     it is returned unchanged (i.e. not truncated)"
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
    ^ self printStringPaddedTo:size with:(Character space)
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
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7485
     123 printStringPaddedTo:10
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7486
     1234567890123456 printStringPaddedTo:10
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7487
     'hello' printStringPaddedTo:10
5755
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
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7490
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7491
printStringPaddedTo:size ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7492
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7493
     padded with spaces (at the right) up to size.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7494
     If the resulting printString is too large,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7495
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7496
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7497
    ^ self printStringPaddedTo:size with:(Character space) ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7498
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7499
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7500
     12   printStringPaddedTo:3 ifLarger:['***']
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7501
     123  printStringPaddedTo:3 ifLarger:['***']
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7502
     1234 printStringPaddedTo:3 ifLarger:['***']
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7503
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7504
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7505
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7506
printStringPaddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7507
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7508
     padded with padCharacter (at the right) up to size.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7509
     If the printString is longer than size,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7510
     it is returned unchanged (i.e. not truncated)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7511
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7512
    ^ (self printString) paddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7513
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7514
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7515
     123  printStringPaddedTo:10 with:$.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7516
     123  printStringPaddedTo:10 with:$*
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7517
     123  printStringPaddedTo:3 with:$*
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7518
     1234 printStringPaddedTo:3 with:$*
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7519
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7520
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7521
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7522
printStringPaddedTo:size with:padCharacter ifLarger:alternative
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7523
    "return a printed representation of the receiver,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7524
     padded with padCharacter (at the right) up to size.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7525
     If the resulting printString is too large,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7526
     return the result from evaluating alternative."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7527
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7528
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7529
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7530
    s := self printString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7531
    s size > size ifTrue:[^ alternative value].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7532
    ^ s paddedTo:size with:padCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7533
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7534
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7535
     123   printStringPaddedTo:3 with:$. ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7536
     12345 printStringPaddedTo:3 with:$. ifLarger:['***']
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7537
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7538
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7539
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7540
printStringRightAdjustLen:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7541
    "obsolete - just a name confusion.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7542
     This method will go away ..."
11068
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7543
    <resource: #obsolete>
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7544
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7545
    ^ self printStringLeftPaddedTo:size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7546
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7547
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7548
printStringZeroPaddedTo:size
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7549
    "return a printed representation of the receiver,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7550
     padded with zero (at the right) characters up to size.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7551
     Usually used with float numbers."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7552
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7553
    ^ self printStringPaddedTo:size with:$0
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7554
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7555
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7556
     123.0 printStringZeroPaddedTo:10
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7557
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7558
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7559
8287
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  7560
printfPrintString:ignoredFormat
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  7561
    "fallback to default printString
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  7562
     (for compatibility with float and integer-printing)"
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  7563
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  7564
    ^ self printString
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  7565
!
9770f4ad54ff +printfPrintString
werner
parents: 8273
diff changeset
  7566
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7567
store
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7568
    "store the receiver on standard output.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7569
     this method is useless, but included for compatibility."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7570
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7571
    self storeOn:Stdout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7572
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7573
7600
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  7574
storeArrayElementOn:aStream
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  7575
    "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
  7576
     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
  7577
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  7578
    ^ 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
  7579
!
5a3fee21c032 #storeString - omit # from Symbols and Arrays that are elements of an array.
Stefan Vogel <sv@exept.de>
parents: 7576
diff changeset
  7580
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7581
storeCR
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7582
    "store the receiver on standard output; append a carriage return."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7583
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7584
    self store.
11068
a5ef673886fd #printOn:format: and #printStringFormat for Date/Time compatibility
Stefan Vogel <sv@exept.de>
parents: 11065
diff changeset
  7585
    Stdout cr.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7586
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7587
    "Created: 20.5.1996 / 10:26:01 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7588
    "Modified: 20.5.1996 / 10:26:57 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7589
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7590
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7591
storeNl
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7592
    "store the receiver on standard output; append a newline.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7593
     This method is included for backward compatibility-  use #storeCR."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7594
5893
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7595
    <resource:#obsolete>
f92054b38d3c Assign #obsolete resource to obsolete methods
Stefan Vogel <sv@exept.de>
parents: 5879
diff changeset
  7596
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7597
    self storeCR.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7598
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7599
    "Modified: 20.5.1996 / 10:26:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7600
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7601
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7602
storeOn:aStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7603
    "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
  7604
     reconstruct the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7605
     Notice, that no self referencing or cyclic objects can be represented
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7606
     in this format.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7607
     Use storeBinaryOn:, which handles these cases correctly."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7608
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7609
    |myClass hasSemi sz "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7610
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7611
    thisContext isRecursive ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7612
	RecursiveStoreError raiseRequestWith:self.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7613
	'Object [error]: storeString of self referencing object (' errorPrint.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7614
	self class name errorPrint.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7615
	')' errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7616
	aStream nextPutAll:'#("recursive")'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7617
	^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7618
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7619
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7620
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7621
    aStream nextPut:$(.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7622
    aStream nextPutAll:self class name.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7623
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7624
    hasSemi := false.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7625
    myClass isVariable ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7626
	aStream nextPutAll:' basicNew:'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7627
	self basicSize printOn:aStream
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7628
    ] ifFalse:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7629
	aStream nextPutAll:' basicNew'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7630
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7631
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7632
    sz := myClass instSize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7633
    1 to:sz do:[:i |
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7634
	|ref|
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7635
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7636
	ref := (self instVarAt:i).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7637
	"/ no need to store nil entries, because the object has been instantiated
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7638
	"/ with basicNew just a moment ago (so the fields are already nil)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7639
	ref notNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7640
	    aStream nextPutAll:' instVarAt:'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7641
	    i printOn:aStream.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7642
	    aStream nextPutAll:' put:'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7643
	    ref storeOn:aStream.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7644
	    aStream nextPut:$;.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7645
	    hasSemi := true
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7646
	].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7647
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7648
    myClass isVariable ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7649
	sz := self basicSize.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7650
	1 to:sz do:[:i |
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7651
	    |ref|
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7652
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7653
	    ref := (self basicAt:i).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7654
	    "/ no need to store nil entries, because the object has been instantiated
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7655
	    "/ with basicNew just a moment ago (so the fields are already nil)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7656
	    ref notNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7657
		aStream nextPutAll:' basicAt:'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7658
		i printOn:aStream.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7659
		aStream nextPutAll:' put:'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7660
		ref storeOn:aStream.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7661
		aStream nextPut:$;.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7662
		hasSemi := true
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7663
	    ]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7664
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7665
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7666
    hasSemi ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7667
	aStream nextPutAll:' yourself'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7668
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7669
    aStream nextPut:$).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7670
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7671
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7672
     |s|
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
     s := WriteStream on:(String new).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7675
     ('hello' -> 'world') storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7676
     s := ReadStream on:(s contents).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7677
     (Object readFrom:s) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7678
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7679
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7680
     |s|
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
     s := 'data' asFilename writeStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7683
     ('hello' -> 'world') storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7684
     s close.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7685
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7686
     s := 'data' asFilename readStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7687
     (Object readFrom:s) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7688
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7689
16590
c6a17a505282 class: Object
Claus Gittinger <cg@exept.de>
parents: 16588
diff changeset
  7690
    "does not work example (cyclic):"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7691
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7692
     |s a|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7693
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7694
     a := Array new:2.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7695
     a at:1 put:a.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7696
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7697
     s := 'data' asFilename writeStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7698
     a storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7699
     s close.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7700
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7701
     s := 'data' asFilename readStream.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7702
     (Object readFrom:s) inspect
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7703
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7704
13162
dd688290df14 changed: #storeOn:
Claus Gittinger <cg@exept.de>
parents: 13140
diff changeset
  7705
    "Modified: / 03-12-2010 / 13:27:51 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7706
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7708
storeString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7709
    "return a string representing an expression to reconstruct the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7710
     Notice, that no self referencing or cyclic objects can be represented
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7711
     in this format.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7712
     Use storeBinaryOn:, which handles these cases correctly."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7713
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7714
    |s|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7715
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7716
    s := WriteStream on:(String new:50).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7717
    self storeOn:s.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7718
    ^ s contents
13350
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7719
!
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7720
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7721
withErrorStreamDo:aBlock
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7722
    "{ Pragma: +optSpace }"
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7723
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  7724
    "helper for error messages - evaluate aBlock,
16378
d88d0cc60491 class: Object
Claus Gittinger <cg@exept.de>
parents: 16349
diff changeset
  7725
     passing it a stream on which to put error messages."
13350
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7726
13578
aa9827cafc2c signalInterrupt: - tell which process was killed
Claus Gittinger <cg@exept.de>
parents: 13566
diff changeset
  7727
    |stream|
aa9827cafc2c signalInterrupt: - tell which process was killed
Claus Gittinger <cg@exept.de>
parents: 13566
diff changeset
  7728
16383
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  7729
    "CG: care for standalone non-GUI progs, which have no userPreferences class"
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  7730
    (Smalltalk isInitialized
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  7731
    and:[ UserPreferences notNil
4cb54426f3c0 class: Object
Claus Gittinger <cg@exept.de>
parents: 16378
diff changeset
  7732
    and:[ UserPreferences current sendMessagesAlsoToTranscript]]) ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  7733
	stream := Processor activeProcess isSystemProcess
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  7734
			ifTrue:[Stderr]
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  7735
			ifFalse:[Transcript].
16378
d88d0cc60491 class: Object
Claus Gittinger <cg@exept.de>
parents: 16349
diff changeset
  7736
    ].
d88d0cc60491 class: Object
Claus Gittinger <cg@exept.de>
parents: 16349
diff changeset
  7737
    stream notNil ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  7738
	StreamError catch:[
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  7739
	    aBlock value:stream.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  7740
	].
13578
aa9827cafc2c signalInterrupt: - tell which process was killed
Claus Gittinger <cg@exept.de>
parents: 13566
diff changeset
  7741
    ].
14162
79def684ccac changed: #withErrorStreamDo:
Stefan Vogel <sv@exept.de>
parents: 14079
diff changeset
  7742
    stream ~~ Stderr ifTrue:[
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  7743
	aBlock value:Stderr.
13350
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7744
    ].
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7745
8c7603161369 added: #withErrorStreamDo:
Claus Gittinger <cg@exept.de>
parents: 13320
diff changeset
  7746
    "Created: / 21-04-2011 / 12:46:21 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7749
!Object methodsFor:'queries'!
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
basicSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7752
    "return the number of the receivers indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7753
     0 if it has none.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7754
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7755
     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
  7756
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7757
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  7758
#ifdef __SCHTEAM__
18404
ae9230dde5ca comments
Claus Gittinger <cg@exept.de>
parents: 18371
diff changeset
  7759
    return context._RETURN( STInteger._new( self.basicSize() ) );
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7760
#else
8909
485a8e3153e0 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8901
diff changeset
  7761
    REGISTER INT nbytes;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7762
    REGISTER OBJ myClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7763
    int nInstBytes;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7764
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7765
    /*
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7766
     * notice the missing test for self being a nonNilObject -
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7767
     * this can be done since basicSize is defined both in UndefinedObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7768
     * and SmallInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7769
     */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7770
    myClass = __qClass(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7771
    nbytes = __qSize(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7772
    nInstBytes = OHDR_SIZE + __OBJS2BYTES__( __intVal(__ClassInstPtr(myClass)->c_ninstvars) );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7773
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7774
    switch ((INT)(__ClassInstPtr(myClass)->c_flags) & __MASKSMALLINT(ARRAYMASK)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7775
	case __MASKSMALLINT(POINTERARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7776
	case __MASKSMALLINT(WKPOINTERARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7777
	    nbytes -= nInstBytes;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7778
	    RETURN ( __mkSmallInteger(__BYTES2OBJS__(nbytes)) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7779
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7780
	case __MASKSMALLINT(BYTEARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7781
	    nbytes -= nInstBytes;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7782
	    RETURN ( __mkSmallInteger(nbytes / sizeof(char)) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7783
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7784
	case __MASKSMALLINT(FLOATARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7785
	    nbytes -= nInstBytes;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7786
	    RETURN ( __mkSmallInteger(nbytes / sizeof(float)) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7787
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7788
	case __MASKSMALLINT(DOUBLEARRAY):
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7789
# ifdef __NEED_DOUBLE_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7790
	    nInstBytes = (nInstBytes-1+__DOUBLE_ALIGN) &~ (__DOUBLE_ALIGN-1);
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7791
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7792
	    nbytes -= nInstBytes;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7793
	    RETURN ( __mkSmallInteger(nbytes / sizeof(double)) );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7794
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7795
	case __MASKSMALLINT(WORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7796
	case __MASKSMALLINT(SWORDARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7797
	    nbytes -= nInstBytes;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7798
	    RETURN ( __mkSmallInteger(nbytes>>1) ); /* notice the hardcoded 2 here - not sizeof(short) */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7799
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7800
	case __MASKSMALLINT(LONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7801
	case __MASKSMALLINT(SLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7802
	    nbytes -= nInstBytes;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7803
	    RETURN ( __mkSmallInteger(nbytes>>2) ); /* notice the hardcoded 4 here - not sizeof(int) */
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7804
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7805
	case __MASKSMALLINT(LONGLONGARRAY):
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7806
	case __MASKSMALLINT(SLONGLONGARRAY):
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7807
# ifdef __NEED_LONGLONG_ALIGN
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7808
	    nInstBytes = (nInstBytes-1+__LONGLONG_ALIGN) &~ (__LONGLONG_ALIGN-1);
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7809
# endif
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7810
	    nbytes -= nInstBytes;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7811
	    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
  7812
    }
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  7813
#endif /* not __SCHTEAM__ */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7814
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7815
    ^ 0
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7816
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7817
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7818
byteSize
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7819
    "return the number of bytes in the receivers indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7820
     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
  7821
     instvars i.e. byteArrays, wordArrays etc.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7822
     Notice: for Strings the returned size may look strange.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7823
     Only useful with binary storage."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7824
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7825
    |myClass|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7826
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7827
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7828
    myClass isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7829
	myClass isPointers ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7830
	    myClass isBytes ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7831
		^ self basicSize.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7832
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7833
	    myClass isWords ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7834
		^ self basicSize * 2.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7835
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7836
	    myClass isSignedWords ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7837
		^ self basicSize * 2.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7838
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7839
	    myClass isLongs ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7840
		^ self basicSize * 4.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7841
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7842
	    myClass isSignedLongs ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7843
		^ self basicSize * 4.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7844
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7845
	    myClass isLongLongs ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7846
		^ self basicSize * 8.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7847
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7848
	    myClass isSignedLongLongs ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7849
		^ self basicSize * 8.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7850
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7851
	    myClass isFloats ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7852
		^ self basicSize * (ExternalBytes sizeofFloat)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7853
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7854
	    myClass isDoubles ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7855
		^ self basicSize * (ExternalBytes sizeofDouble)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7856
	    ].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7857
	    self error:'unknown variable size class species'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7858
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7859
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7860
    ^ 0
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7861
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7862
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7863
     Point new byteSize
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  7864
     'hello' byteSize
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  7865
     'hello' asUnicode16String byteSize
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7866
     (ByteArray with:1 with:2) byteSize
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7867
     (FloatArray with:1.5) byteSize
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7868
     (DoubleArray with:1.5) byteSize
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7869
     (WordArray with:1 with:2) byteSize
5755
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
!
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
class
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7874
    "return the receivers class"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7875
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7876
%{  /* NOCONTEXT */
18240
28af09029a8b ifdef for SCHTEAM engine changed (not relevant for ST/X)
Claus Gittinger <cg@exept.de>
parents: 18238
diff changeset
  7877
#ifdef __SCHTEAM__
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7878
    return context._RETURN(self.clazz());
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7879
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7880
    RETURN ( __Class(self) );
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7881
#endif
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7882
%}
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
respondsTo:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7886
    "return true, if the receiver implements a method with selector equal
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7887
     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
  7888
     receivers class or one of its superclasses.
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
     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
  7891
     an error being raised. For example, an implementation could send
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7892
     #shouldNotImplement or #subclassResponsibility."
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
     should we go via the cache, or search (by class) ?
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7896
     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
  7897
     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
  7898
     For now, use the cache ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7899
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7900
%{  /* NOCONTEXT */
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
    if (__lookup(__Class(self), aSelector) == nil) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  7903
	RETURN ( false );
5755
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
    RETURN ( true );
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
    ^ self class canUnderstand:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7909
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7910
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7911
    "'aString' respondsTo:#+"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7912
    "'aString' respondsTo:#,"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7913
    "'aString' respondsTo:#collect:"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7914
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7915
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7916
respondsToArithmetic
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7917
    "return true, if the receiver responds to arithmetic messages.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7918
     false is returned here - the method is redefined in ArithmeticValue."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7919
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7920
    ^ false
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7923
size
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7924
    "return the number of the receivers indexed instance variables;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7925
     this method may be redefined in subclasses"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7926
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7927
    ^ self basicSize
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7930
species
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7931
    "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
  7932
     This is used to create an appropriate object when creating derived
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7933
     copies in the collection classes (sometimes redefined)."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7934
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7935
    ^ self class
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7936
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7937
16401
ae4c51e826cb class: Object
Claus Gittinger <cg@exept.de>
parents: 16383
diff changeset
  7938
speciesForCopy
ae4c51e826cb class: Object
Claus Gittinger <cg@exept.de>
parents: 16383
diff changeset
  7939
    "return a class which is the receiver's class, except for readonly objects,
ae4c51e826cb class: Object
Claus Gittinger <cg@exept.de>
parents: 16383
diff changeset
  7940
     such as immutable collections.
ae4c51e826cb class: Object
Claus Gittinger <cg@exept.de>
parents: 16383
diff changeset
  7941
     This is only to be used by copy methods"
ae4c51e826cb class: Object
Claus Gittinger <cg@exept.de>
parents: 16383
diff changeset
  7942
ae4c51e826cb class: Object
Claus Gittinger <cg@exept.de>
parents: 16383
diff changeset
  7943
    ^ self class
ae4c51e826cb class: Object
Claus Gittinger <cg@exept.de>
parents: 16383
diff changeset
  7944
!
ae4c51e826cb class: Object
Claus Gittinger <cg@exept.de>
parents: 16383
diff changeset
  7945
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7946
yourself
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7947
    "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
  7948
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7949
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7950
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7951
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  7952
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7953
!Object methodsFor:'secure message sending'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7954
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7955
?:selector
13099
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7956
    "try to send a message to the receiver;
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7957
     if understood, return the value;
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7958
     if not, return nil."
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  7959
13099
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7960
    ^ self perform:selector ifNotUnderstood:nil
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7961
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7962
    "
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7963
     ApplicationModel new masterApplication resources first             - error
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7964
     ApplicationModel new ?: #masterApplication ?: #resources ?: #first - nil
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7965
    "
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7966
    "Modified: / 20-10-2010 / 10:45:21 / cg"
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7967
!
fdcece3bda6c added: #?:
Claus Gittinger <cg@exept.de>
parents: 13039
diff changeset
  7968
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7969
askFor:aSelector
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7970
    "try to send the receiver the message, aSelector.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7971
     If it does not understand it, return false.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7972
     Otherwise the real value returned.
11398
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7973
     Useful to send messages such as: #isColor to unknown receivers."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7974
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7975
    ^ self perform:aSelector ifNotUnderstood:[false]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7976
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7977
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7978
     1 askFor:#isColor
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7979
     Color red askFor:#isColor
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7980
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7981
     1 askFor:#isFoo
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  7982
     Color red askFor:#isFoo
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7983
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7984
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  7985
11398
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7986
askFor:aSelector with:argument
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7987
    "try to send the receiver the message, aSelector.
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7988
     If it does not understand it, return false.
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7989
     Otherwise the real value returned.
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7990
     Useful to send messages such as: #isXXX: to unknown receivers."
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7991
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7992
    ^ self perform:aSelector with:argument ifNotUnderstood:[false]
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7993
!
1f006dd241a7 +askFor:with:
Claus Gittinger <cg@exept.de>
parents: 11366
diff changeset
  7994
11401
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  7995
askFor:aSelector with:arg1 with:arg2
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  7996
    "try to send the receiver the message, aSelector.
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  7997
     If it does not understand it, return false.
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  7998
     Otherwise the real value returned.
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  7999
     Useful to send messages such as: #isXXX: to unknown receivers."
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  8000
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  8001
    ^ self perform:aSelector with:arg1 with:arg2 ifNotUnderstood:[false]
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  8002
!
78104cb2fba3 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11398
diff changeset
  8003
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8004
perform:aSelector ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8005
    "try to send message aSelector to the receiver.
12157
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8006
     If its understood, return the method's returned value,
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8007
     otherwise return the value of the exceptionBlock.
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8008
     Read this:
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8009
     Many programmers do an Error-handle to perform a similar
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8010
     checked-message send. However, this method is more specific,
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8011
     in that only errors for the given selector are caught - not any other
12157
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8012
     doesNotUnderstand, and especially not any other error."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8013
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8014
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8015
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  8016
    MessageNotUnderstood handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8017
	"/ reject, if the bad message is not the one
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8018
	"/ we have sent originally
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8019
	(ex selector == aSelector and:[ex receiver == self]) ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8020
	    ex reject
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8021
	].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8022
    ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8023
	val := self perform:aSelector.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8024
	ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8025
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8026
    ok isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8027
	^ exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8028
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8029
    ^ val
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8030
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8031
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8032
     1.2345 perform:#foo ifNotUnderstood:['sorry']
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8033
     1.2345 perform:#sqrt ifNotUnderstood:['sorry']
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8034
     12345 perform:#sqrt ifNotUnderstood:['sorry']
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8035
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8036
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8037
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8038
perform:aSelector with:argument ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8039
    "try to send message aSelector to the receiver.
12157
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8040
     If its understood, return the method's returned value,
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8041
     otherwise return the value of the exceptionBlock.
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8042
     Read this:
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8043
     Many programmers do an Error-handle to perform a similar
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8044
     checked-message send. However, this method is more specific,
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8045
     in that only errors for the given selector are caught - not any other
12157
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8046
     doesNotUnderstand, and especially not any other error."
5755
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
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8049
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8050
    MessageNotUnderstood handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8051
	"/ reject, if the bad message is not the one
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8052
	"/ we have sent originally
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8053
	(ex selector == aSelector and:[ex receiver == self]) ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8054
	    ex reject
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8055
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8056
    ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8057
	val := self perform:aSelector with:argument.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8058
	ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8059
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8060
    ok isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8061
	^ exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8062
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8063
    ^ val
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8064
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8065
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8066
     |unknown|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8067
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8068
     unknown := 4.
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8069
     (unknown perform:#- with:2 ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8070
     unknown := 'high there'.
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8071
     (unknown perform:#- with:2 ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8072
    "
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
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8075
perform:aSelector with:arg1 with:arg2 ifNotUnderstood:exceptionBlock
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8076
    "try to send message aSelector to the receiver.
12157
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8077
     If its understood, return the method's returned value,
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8078
     otherwise return the value of the exceptionBlock.
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8079
     Read this:
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8080
     Many programmers do an Error-handle to perform a similar
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8081
     checked-message send. However, this method is more specific,
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8082
     in that only errors for the given selector are caught - not any other
12157
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8083
     doesNotUnderstand, and especially not any other error."
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8084
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8085
    |val ok|
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8086
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8087
    MessageNotUnderstood handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8088
	"/ reject, if the bad message is not the one
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8089
	"/ we have sent originally
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8090
	(ex selector == aSelector and:[ex receiver == self]) ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8091
	    ex reject
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8092
	]
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8093
    ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8094
	val := self perform:aSelector with:arg1 with:arg2.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8095
	ok := true.
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8096
    ].
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8097
    ok isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8098
	^ exceptionBlock value
5926
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8099
    ].
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8100
    ^ val
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8101
!
e5ce56a2bd40 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5912
diff changeset
  8102
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8103
perform:aSelector withArguments:argumentArray ifNotUnderstood:exceptionBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8104
    "try to send message aSelector to the receiver.
12157
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8105
     If its understood, return the method's returned value,
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8106
     otherwise return the value of the exceptionBlock.
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8107
     Read this:
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8108
     Many programmers do an Error-handle to perform a similar
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8109
     checked-message send. However, this method is more specific,
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8110
     in that only errors for the given selector are caught - not any other
12157
114823c8f3b0 comment/format in:
Claus Gittinger <cg@exept.de>
parents: 12050
diff changeset
  8111
     doesNotUnderstand, and especially not any other error."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8112
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8113
    |val ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8114
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8115
    MessageNotUnderstood handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8116
	"/ reject, if the bad message is not the one
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8117
	"/ we have sent originally.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8118
	(ex selector == aSelector and:[ex receiver == self]) ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8119
	    ex reject
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8120
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8121
    ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8122
	val := self perform:aSelector withArguments:argumentArray.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8123
	ok := true.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8124
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8125
    ok isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8126
	^ exceptionBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8127
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8128
    ^ val
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8131
     |unknown|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8132
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8133
     unknown := 4.
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8134
     (unknown perform:#- withArguments:#(2) ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8135
     unknown := 'high there'.
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8136
     (unknown perform:#- withArguments:#(2) ifNotUnderstood:['sorry']) printNewline.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8137
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8138
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8139
    "Modified: 27.3.1997 / 14:13:16 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8140
! !
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
!Object methodsFor:'signal constants'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8143
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8144
messageNotUnderstoodSignal
6146
88b5066282b1 copyToLevcel: and copyTwoLevel
james
parents: 6086
diff changeset
  8145
    ^ MessageNotUnderstood
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8146
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8147
    "Created: 6.3.1997 / 15:46:52 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8148
! !
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
!Object methodsFor:'special queries'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8151
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8152
allOwners
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8153
    "return a collection of all objects referencing the receiver"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8154
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8155
    ^ ObjectMemory whoReferences:self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8156
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8157
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8158
references:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8159
    "return true, if the receiver refers to the argument, anObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8160
     - for debugging only"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8161
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8162
    ^ self referencesObject:anObject
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8163
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8164
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8165
     |v|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8166
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8167
     v := View new initialize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8168
     v references:Display.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8169
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8170
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8171
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8172
referencesAny:aCollection
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8173
    "return true, if the receiver refers to any object from
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8174
     the argument, aCollection.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8175
     - for debugging only"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8176
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8177
%{
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8178
    OBJ cls, flags;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8179
    int nInsts, inst;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8180
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8181
    if (! __isNonNilObject(self)) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8182
	RETURN (false);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8183
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8184
8934
32a063645991 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8930
diff changeset
  8185
    if (__isArrayLike(aCollection)) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8186
	int nObjs = __arraySize(aCollection);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8187
	char *minAddr = 0, *maxAddr = 0;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8188
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8189
	if (nObjs == 0) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8190
	    RETURN (false);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8191
	}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8192
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8193
	cls = __qClass(self);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8194
	flags = __ClassInstPtr(cls)->c_flags;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8195
	if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8196
	    nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8197
	} else {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8198
	    nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8199
	}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8200
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8201
	if (nObjs == 1) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8202
	    /* better reverse the loop */
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8203
	    OBJ anObject = __arrayVal(aCollection)[0];
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8204
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8205
	    if (anObject == cls) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8206
		RETURN(true);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8207
	    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8208
	    if (! nInsts) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8209
		RETURN (false);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8210
	    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8211
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8212
	    if ((__qSpace(self) <= OLDSPACE)
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8213
		    && !__isRemembered(self)
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8214
		    && __isNonNilObject(anObject)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8215
		int spc = __qSpace(anObject);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8216
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8217
		if ((spc == NEWSPACE) || (spc == SURVSPACE)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8218
		    RETURN(false);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8219
		}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8220
	    }
16325
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8221
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8222
# if defined(memsrch4)
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8223
	    if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8224
		RETURN (true);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8225
	    }
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8226
# else
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8227
	    for (inst=0; inst<nInsts; inst++) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8228
		if ((__InstPtr(self)->i_instvars[inst]) == anObject) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8229
		    RETURN (true);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8230
		}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8231
	    }
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8232
# endif
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8233
	    RETURN (false);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8234
	}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8235
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8236
	/*
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8237
	 * a little optimization: use the fact that all old objects
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8238
	 * refering to a new object are on the remSet; if I am not,
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8239
	 * a trivial reject is possible, if all objects are newbees.
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8240
	 * as a side effect, gather min/max addresses
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8241
	 */
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8242
	if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8243
	    int allNewBees = 1;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8244
	    int i;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8245
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8246
	    minAddr = (char *)(__arrayVal(aCollection)[0]);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8247
	    maxAddr = minAddr;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8248
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8249
	    for (i=0; i<nObjs; i++) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8250
		OBJ anObject = __arrayVal(aCollection)[i];
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8251
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8252
		if (__isNonNilObject(anObject)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8253
		    int spc = __qSpace(anObject);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8254
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8255
		    if ((spc != NEWSPACE) && (spc != SURVSPACE)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8256
			allNewBees = 0;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8257
		    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8258
		}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8259
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8260
		if ((char *)anObject < minAddr) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8261
		    minAddr = (char *)anObject;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8262
		} else if ((char *)anObject > maxAddr) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8263
		    maxAddr = (char *)anObject;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8264
		}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8265
	    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8266
	    if (allNewBees) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8267
		RETURN (false);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8268
	    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8269
	}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8270
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8271
	/*
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8272
	 * fetch min/max in searchList (if not already done above)
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8273
	 */
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8274
	if (minAddr == 0) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8275
	    int i;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8276
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8277
	    for (i=0; i<nObjs; i++) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8278
		char  *anObject = (char *)__arrayVal(aCollection)[i];
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8279
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8280
		if (anObject < minAddr) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8281
		    minAddr = anObject;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8282
		} else if (anObject > maxAddr) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8283
		    maxAddr = anObject;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8284
		}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8285
	    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8286
	}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8287
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8288
	if (((char *)cls >= minAddr) && ((char *)cls <= maxAddr)) {
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8289
# if defined(memsrch4)
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8290
	    if (memsrch4(__arrayVal(aCollection), (INT)cls, nObjs)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8291
		RETURN (true);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8292
	    }
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8293
# else
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8294
	    int i;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8295
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8296
	    for (i=0; i<nObjs; i++) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8297
		if (cls == __arrayVal(aCollection)[i]) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8298
		    RETURN (true);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8299
		}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8300
	    }
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8301
# endif /* memsrch4 */
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8302
	}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8303
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8304
	for (inst=0; inst<nInsts; inst++) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8305
	    OBJ instVar = __InstPtr(self)->i_instvars[inst];
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8306
	    int i;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8307
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8308
	    if (((char *)instVar >= minAddr) && ((char *)instVar <= maxAddr)) {
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8309
# if defined(memsrch4)
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8310
		if (memsrch4(__arrayVal(aCollection), (INT)instVar, nObjs)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8311
		    RETURN (true);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8312
		}
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8313
# else
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8314
		for (i=0; i<nObjs; i++) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8315
		    if (instVar == __arrayVal(aCollection)[i]) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8316
			RETURN (true);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8317
		    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8318
		}
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8319
# endif /* memsrch4 */
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8320
	    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8321
	}
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8322
	RETURN (false);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8323
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8324
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8325
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8326
    aCollection do:[:el |
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8327
	(self referencesObject:el) ifTrue:[^ true].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8328
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8329
    ^ false
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
referencesDerivedInstanceOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8333
    "return true, if the receiver refers to an instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8334
     the argument, aClass or its subclass. This method exists
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8335
     to support searching for users of a class."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8336
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8337
    |myClass
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8338
     numInst "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8339
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8340
    "check the class"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8341
    (self isKindOf:aClass) ifTrue:[^ true].
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  8342
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8343
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8344
    "check the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8345
    numInst := myClass instSize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8346
    1 to:numInst do:[:i |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8347
	((self instVarAt:i) isKindOf:aClass) ifTrue:[^ true]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8348
    ].
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
    "check the indexed variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8351
    myClass isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8352
	myClass isPointers ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8353
	    "no need to search in non pointer fields"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8354
	    ((aClass == Number) or:[aClass isSubclassOf:Number]) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8355
	].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8356
	numInst := self basicSize.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8357
	1 to:numInst do:[:i |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8358
	    ((self basicAt:i) isKindOf:aClass) ifTrue:[^ true]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8359
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8360
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8361
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8362
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8363
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8364
     (1 @ 3.4) referencesDerivedInstanceOf:Number
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8365
     (1 @ 3.4) referencesDerivedInstanceOf:Array
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8366
     View new initialize referencesDerivedInstanceOf:DeviceWorkstation
5755
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
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8370
referencesForWhich:checkBlock do:actionBlock
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8371
    |myClass inst
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8372
     numInst "{ Class: SmallInteger }" |
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8373
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8374
    myClass := self class.
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8375
    "check the instance variables"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8376
    numInst := myClass instSize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8377
    1 to:numInst do:[:i |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8378
	inst := self instVarAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8379
	(checkBlock value:inst) ifTrue:[actionBlock value:inst].
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8380
    ].
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8381
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8382
    "check the indexed variables"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8383
    myClass isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8384
	myClass isPointers ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8385
	    "no need to search in non pointer fields"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8386
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8387
	    numInst := self basicSize.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8388
	    1 to:numInst do:[:i |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8389
		inst := self basicAt:i.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8390
		(checkBlock value:inst) ifTrue:[actionBlock value:inst].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8391
	    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8392
	]
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8393
    ].
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8394
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8395
    "
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8396
     (1 @ 3.4) referencesForWhich:[:i | i isFloat] do:[:i | Transcript showCR:i]
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8397
    "
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8398
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  8399
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8400
referencesInstanceOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8401
    "return true, if the receiver refers to an instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8402
     the argument, aClass.This method exists
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8403
     to support searching for users of a class."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8404
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8405
    |myClass
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8406
     numInst "{ Class: SmallInteger }" |
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8407
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8408
    myClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8409
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8410
    "check the class"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8411
    (myClass isMemberOf:aClass) ifTrue:[^ true].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8412
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8413
    "check the instance variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8414
    numInst := myClass instSize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8415
    1 to:numInst do:[:i |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8416
	((self instVarAt:i) isMemberOf:aClass) ifTrue:[^ true]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8417
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8418
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8419
    "check the indexed variables"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8420
    myClass isVariable ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8421
	myClass isPointers ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8422
	    "no need to search in non-pointer indexed fields"
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8423
	    myClass isLongs ifTrue:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8424
		(aClass == SmallInteger or:[aClass == LargeInteger]) ifFalse:[^ false].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8425
	    ] ifFalse:[
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8426
		myClass isFloatsOrDoubles ifTrue:[^ aClass == Float].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8427
		^ aClass == SmallInteger
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8428
	    ]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8429
	].
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8430
	numInst := self basicSize.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8431
	1 to:numInst do:[:i |
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8432
	    ((self basicAt:i) isMemberOf:aClass) ifTrue:[^ true]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8433
	]
5755
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
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8438
     (1 @ 3.4) referencesInstanceOf:Float
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8439
     (1 @ 3.4) referencesInstanceOf:Fraction
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8440
     View new initialize referencesInstanceOf:(Display class)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8441
    "
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8442
!
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8443
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8444
referencesObject:anObject
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8445
    "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
  8446
     - for debugging only"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8447
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8448
%{  /* NOCONTEXT */
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8449
    OBJ cls, flags;
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8450
    int nInsts, i;
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8451
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8452
    if (! __isNonNilObject(self)) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8453
	RETURN (false);
16325
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8454
    }
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8455
    cls = __qClass(self);
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8456
    if (cls == anObject) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8457
	RETURN (true);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8458
    }
16325
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8459
    flags = __ClassInstPtr(cls)->c_flags;
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8460
    if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8461
	nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
16325
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8462
    } else {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8463
	nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
16325
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8464
    }
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8465
    if (! nInsts) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8466
	RETURN (false);
16325
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8467
    }
aea5ba9d95a9 class: Object
Stefan Vogel <sv@exept.de>
parents: 16311
diff changeset
  8468
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8469
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8470
    /*
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8471
     * 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
  8472
     * 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
  8473
     * 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
  8474
     */
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8475
    if (__isNonNilObject(anObject)) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8476
	if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8477
	    int spc;
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8478
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8479
	    if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8480
		RETURN (false);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8481
	    }
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8482
	}
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8483
    }
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8484
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8485
# if defined(memsrch4)
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8486
    if (memsrch4(__InstPtr(self)->i_instvars, (INT)anObject, nInsts)) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8487
	RETURN (true);
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8488
    }
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8489
# else
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8490
    for (i=0; i<nInsts; i++) {
16560
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8491
	if (__InstPtr(self)->i_instvars[i] == anObject) {
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8492
	    RETURN (true);
Claus Gittinger <cg@exept.de>
parents: 16470
diff changeset
  8493
	}
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8494
    }
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8495
# endif /* memsrch4 */
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8496
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8497
%}.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8498
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8499
"/    |myClass
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8500
"/     numInst "{ Class: SmallInteger }" |
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8501
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8502
"/    myClass := self class.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8503
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8504
"/    "check the class"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8505
"/    (myClass == anObject) ifTrue:[^ true].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8506
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8507
"/    "check the instance variables"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8508
"/    numInst := myClass instSize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8509
"/    1 to:numInst do:[:i |
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8510
"/      ((self instVarAt:i) == anObject) ifTrue:[^ true]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8511
"/    ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8512
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8513
"/    "check the indexed variables"
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8514
"/    myClass isVariable ifTrue:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8515
"/      myClass isPointers ifFalse:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8516
"/          "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8517
"/          "/ 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
  8518
"/          "/ 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
  8519
"/          "/ 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
  8520
"/          "/ 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
  8521
"/          "/ 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
  8522
"/          "/ 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
  8523
"/          "/ 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
  8524
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8525
"/          ^ false.
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8526
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8527
"/          "/ alternative:
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8528
"/          "/  anObject isNumber ifFalse:[^ false].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8529
"/      ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8530
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8531
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8532
"/      "/ 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
  8533
"/      "/ idenitytIndex method, use it
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8534
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8535
"/      myClass == Array ifTrue:[
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8536
"/          ^ (self identityIndexOf:anObject) ~~ 0
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8537
"/      ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8538
"/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8539
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8540
"/      "/ otherwise, do it the slow way
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8541
"/      "/
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8542
"/      numInst := self basicSize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8543
"/      1 to:numInst do:[:i |
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8544
"/          ((self basicAt:i) == anObject) ifTrue:[^ true]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8545
"/      ]
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8546
"/    ].
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8547
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8548
    ^ false
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8549
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8550
    "
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8551
     |v|
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8552
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8553
     v := View new initialize.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8554
     v references:Display.
6074
d91c99700e3b renamed #references: (conflict with RB's #references)
Claus Gittinger <cg@exept.de>
parents: 6069
diff changeset
  8555
    "
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8556
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8557
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  8558
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8559
!Object methodsFor:'synchronized evaluation'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8560
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8561
freeSynchronizationSemaphore
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8562
    "free synchronizationSemaphore. May be used, to save memory when
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8563
     an object is no longer used synchronized."
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
    |sema|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8566
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8567
    sema := self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8568
    sema notNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8569
	sema wait.              "/ get lock
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8570
	self synchronizationSemaphore:nil.
5755
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
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8574
     self synchronized:[].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8575
     self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8576
     self freeSynchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8577
    "
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
    "Created: 28.1.1997 / 19:31:20 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8580
    "Modified: 28.1.1997 / 19:47:55 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8581
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8582
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8583
synchronizationSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8584
    "return the synchronization semaphore for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8585
     subclasses may redefine"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8586
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8587
    ^ SynchronizationSemaphores at:self ifAbsent:[].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8588
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8589
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8590
      self synchronizationSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8591
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8592
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8593
    "Modified: 28.1.1997 / 19:47:09 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8594
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8595
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8596
synchronizationSemaphore:aSemaphore
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8597
    "set the synchronisationSemaphore for myself.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8598
     subclasses may redefine this method"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8599
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8600
    aSemaphore isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8601
	"/ remove Semaphore
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8602
	SynchronizationSemaphores removeKey:self ifAbsent:nil.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8603
    ] ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8604
	SynchronizationSemaphores at:self put:aSemaphore.
5755
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
    "Modified: 28.1.1997 / 19:37:48 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8608
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8609
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8610
synchronized:aBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8611
    "evaluate aBlock synchronized, i.e. use a monitor for this object"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8612
6600
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  8613
    |sema wasBlocked|
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  8614
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  8615
    wasBlocked := OperatingSystem blockInterrupts.
5755
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
    sema := self synchronizationSemaphore.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8618
    sema isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8619
	sema := RecursionLock new name:self className.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8620
	self synchronizationSemaphore:sema.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8621
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8622
6600
9c85adf293dd Simplify #synchronized:
Stefan Vogel <sv@exept.de>
parents: 6572
diff changeset
  8623
    wasBlocked ifFalse:[OperatingSystem unblockInterrupts].
7211
87f5d25b5c3d Make synchronizationSemaphore a recursionLock
Stefan Vogel <sv@exept.de>
parents: 7208
diff changeset
  8624
    sema critical:aBlock.
5755
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
       [Object synchronized:[Delay waitForSeconds:2. Transcript showCR:'1']] fork.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8628
       [Object synchronized:[Delay waitForSeconds:2. Transcript showCR:'2']] fork.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8629
    "
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
    "Created: 28.1.1997 / 17:52:56 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8632
    "Modified: 30.1.1997 / 13:38:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8633
    "Modified: 20.2.1997 / 09:43:35 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8634
! !
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
!Object methodsFor:'system primitives'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8637
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8638
asOop
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8639
    "ST-80 compatibility:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8640
     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
  8641
     or index); since ST/X has no such thing, and the objects address cannot
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8642
     be used (since its changing over time), we return the objects identityHash
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8643
     key, which provides (at least) some identity indication.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8644
     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
  8645
     key of two non-identical objects may be the same.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8646
     You'd better not use it - especially do not misuse it."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8647
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8648
    ^ self identityHash
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8649
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8650
    "Created: 9.11.1996 / 19:09:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8651
    "Modified: 9.11.1996 / 19:16:04 / cg"
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
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8654
beImmutable
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8655
    "experimental - not yet usable; do not use"
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8656
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8657
%{  /* NOCONTEXT */
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8658
    if (! __isNonNilObject(self)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8659
	RETURN (self);
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8660
    }
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8661
    __beImmutable(self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8662
%}
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8663
!
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8664
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8665
beMutable
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8666
    "experimental - not yet usable; do not use"
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8667
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8668
%{  /* NOCONTEXT */
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8669
    if (! __isNonNilObject(self)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8670
	RETURN (self);
8939
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8671
    }
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8672
    __beMutable(self);
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8673
%}
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8674
!
ac97eb450b97 Fix examples in #perform:*ifNotUnderstood:
Stefan Vogel <sv@exept.de>
parents: 8935
diff changeset
  8675
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8676
become:anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8677
    "make all references to the receiver become references to anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8678
     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
  8679
     This can be a very dangerous operation - be warned.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8680
     In general, using #become: should be avoided if possible, since it may
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8681
     produce many strange effects (think of hashing in Sets, Dictionaries etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8682
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8683
     This may also be an expensive (i.e. slow) operation,
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8684
     since in the worst case, the whole memory has to be searched for
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8685
     references to the two objects (although the primitive tries hard to
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8686
     limit the search, for acceptable performance in most cases).
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8687
     This method fails, if the receiver or the argument is a SmallInteger
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8688
     or nil, or is a context of a living method (i.e. one that has not already
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8689
     returned).
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8690
     (notice that #become: is not used heavily by the system
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8691
      - the Collection-classes have been rewritten to not use it.)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8692
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8693
    if (__primBecome(self, anotherObject)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8694
	RETURN ( self );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8695
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8696
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8697
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8698
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8699
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8700
becomeNil
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8701
    "make all references to the receiver become nil - effectively getting
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8702
     rid of the receiver.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8703
     This can be a very dangerous operation - be warned.
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
     This may be an expensive (i.e. slow) operation.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8706
     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
  8707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8708
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8709
    if (__primBecomeNil(self)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8710
	RETURN ( nil );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8711
    }
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
    self primitiveFailed
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
becomeSameAs:anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8717
    "make all references to the receiver become references to anotherObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8718
     but NOT vice versa (as done in #become:).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8719
     This can be a very dangerous operation - be warned.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8720
     In general, using #become: should be avoided if possible, since it may
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8721
     produce many strange effects (think of hashing in Sets, Dictionaries etc.).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8722
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8723
     This may also be an expensive (i.e. slow) operation,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8724
     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
  8725
     references to the two objects (although the primitive tries hard to
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8726
     limit the search, for acceptable performance in most cases).
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8727
     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
  8728
     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
  8729
%{
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8730
    if (__primBecomeSameAs(self, anotherObject)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8731
	RETURN ( self );
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8732
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8733
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8734
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8735
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8736
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8737
changeClassTo:otherClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8738
    "changes the class of the receiver to the argument, otherClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8739
     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
  8740
     have the same structure (i.e. number of named instance variables and
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8741
     type of indexed instance variables).
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8742
     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
  8743
     is UndefinedObject or a Smallinteger, a primitive error is triggered."
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
    |myClass ok|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8746
9405
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  8747
    otherClass autoload.
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  8748
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8749
    "check for UndefinedObject/SmallInteger receiver or newClass"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8750
%{
18371
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8751
#ifdef __SCHTEAM__
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8752
    ok = (self.isSTInstance() && otherClass.isSTInstance())
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8753
	    ? STObject.True : STObject.False;
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8754
#else
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8755
    {
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8756
	OBJ other = otherClass;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8757
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8758
	if (__isNonNilObject(self)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8759
	 && __isNonNilObject(other)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8760
	 && (other != UndefinedObject)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8761
	 && (other != SmallInteger)) {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8762
	    ok = true;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8763
	} else {
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8764
	    ok = false;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8765
	}
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8766
    }
18371
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8767
#endif /* not SCHTEAM */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8768
%}.
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8769
    ok == true ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8770
	ok := false.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8771
	myClass := self class.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8772
	myClass == otherClass ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8773
	    "nothing to change"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8774
	    ^ self.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8775
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8776
	myClass flags == otherClass flags ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8777
	    myClass instSize == otherClass instSize ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8778
		"same instance layout and types: its ok to do it"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8779
		ok := true.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8780
	    ] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8781
		myClass isPointers ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8782
		    myClass isVariable ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8783
			ok := true
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8784
		    ]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8785
		]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8786
	    ]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8787
	] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8788
	    myClass isPointers ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8789
		"if newClass is a variable class, with instSize <= my instsize,
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8790
		 we can do it (effectively mapping additional instvars into the
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8791
		 variable part) - usefulness is questionable, though"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8792
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8793
		otherClass isPointers ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8794
		    otherClass isVariable ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8795
			otherClass instSize <= (myClass instSize + self basicSize)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8796
			ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8797
			    ok := true
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8798
			]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8799
		    ] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8800
			otherClass instSize == (myClass instSize + self basicSize)
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8801
			ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8802
			    ok := true
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8803
			]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8804
		    ]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8805
		] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8806
		    "it does not make sense to convert pointers to bytes ..."
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8807
		]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8808
	    ] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8809
		"does it make sense, to convert bits ?"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8810
		"could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..."
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8811
		(myClass isBitsExtended and:[otherClass isBitsExtended]) ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8812
		    ok := true
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8813
		]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8814
	    ]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8815
	]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8816
    ].
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8817
    ok == true ifTrue:[
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8818
	"now, change the receiver's class ..."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8819
%{
18371
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8820
#ifdef __SCHTEAM__
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8821
	((STInstance)self).clazz = (STClass)otherClass;
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8822
	return __c__._RETURN(self);
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8823
#else
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8824
	{
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8825
	    OBJ me = self;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8826
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8827
	    // gcc4.4 does not like this:
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8828
	    // __qClass(me) = otherClass;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8829
	    __objPtr(me)->o_class = (CLASS_OBJ)otherClass;
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8830
	    __STORE(me, otherClass);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8831
	    RETURN (me);
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
  8832
	}
18371
fa96aa321a0a comments only
Claus Gittinger <cg@exept.de>
parents: 18361
diff changeset
  8833
#endif /* not SCHTEAM */
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8834
%}.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8835
    ].
9405
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  8836
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8837
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8838
     the receiver cannot be represented as a instance of
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8839
     the desired class.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8840
     For example, you cannot change a bitInstance (byteArray etc.)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8841
     into a pointer object and vice versa.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8842
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8843
    self primitiveFailed
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8844
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8845
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8846
changeClassToThatOf:anObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8847
    "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
  8848
     This is only allowed (possible), if the receivers class and the arguments
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  8849
     class have the same structure (i.e. number of named instance variables and
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8850
     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
  8851
     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
  8852
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8853
    self changeClassTo:(anObject class)
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8854
!
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8855
8935
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8856
isImmutable
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8857
    "experimental - not yet usable; do not use"
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8858
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8859
%{  /* NOCONTEXT */
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8860
    if (! __isNonNilObject(self)) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8861
	RETURN (true);
8935
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8862
    }
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8863
    RETURN (__isImmutable(self) ? true : false);
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8864
%}
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8865
!
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  8866
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8867
replaceReferencesTo:anObject with:newRef
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8868
    "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
  8869
     Return true, if any reference was changed.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8870
     Notice: this does not change the class-reference."
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8871
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8872
%{  /* NOCONTEXT */
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8873
    OBJ cls, flags, anyChange;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8874
    int nInsts, i;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8875
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8876
    if (! __isNonNilObject(self)) {
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8877
	RETURN (false);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8878
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8879
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8880
    /*
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8881
     * a little optimization: use the fact that all old objects
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8882
     * 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
  8883
     * a trivial reject is possible, if anObject is a newbee
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8884
     */
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8885
    if (__isNonNilObject(anObject)) {
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8886
	if ((__qSpace(self) <= OLDSPACE) && !__isRemembered(self)) {
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8887
	    int spc;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8888
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8889
	    if (((spc = __qSpace(anObject)) == NEWSPACE) || (spc == SURVSPACE)) {
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8890
		RETURN (false);
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8891
	    }
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8892
	}
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8893
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8894
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8895
    cls = __qClass(self);
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8896
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8897
    flags = __ClassInstPtr(cls)->c_flags;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8898
    if (((INT)flags & __MASKSMALLINT(ARRAYMASK)) == __MASKSMALLINT(POINTERARRAY)) {
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8899
	nInsts = __BYTES2OBJS__(__qSize(self) - OHDR_SIZE);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8900
    } else {
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8901
	nInsts = __intVal(__ClassInstPtr(cls)->c_ninstvars);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8902
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8903
    if (! nInsts) {
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8904
	RETURN (false);
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8905
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8906
    anyChange = false;
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8907
    for (i=0; i<nInsts; i++) {
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8908
	if (__InstPtr(self)->i_instvars[i] == anObject) {
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8909
	    __InstPtr(self)->i_instvars[i] = newRef;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8910
	    __STORE(self, newRef);
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8911
	    // __dumpObject__(self, __LINE__);
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8912
	    anyChange = true;
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8913
	}
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8914
    }
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8915
    RETURN (anyChange);
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8916
%}.
18231
564b847b61db java support
Claus Gittinger <cg@exept.de>
parents: 18215
diff changeset
  8917
    self primitiveFailed
6033
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8918
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8919
    "
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8920
     |v|
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8921
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8922
     v := Array with:1234 with:'hello' with:Array.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8923
     v replaceReferencesTo:Array with:ByteArray.
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8924
     v inspect
be1b7877b425 + #replaceReferencesTo:with:
Claus Gittinger <cg@exept.de>
parents: 6005
diff changeset
  8925
    "
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8926
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8927
    "Modified: / 30-07-2013 / 21:48:06 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8928
! !
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
!Object methodsFor:'testing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8931
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8932
? defaultValue
11634
657c12384132 Fix spelling
Stefan Vogel <sv@exept.de>
parents: 11573
diff changeset
  8933
     "a syntactic sugar-piece:
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8934
      if the receiver is nil, return the defaultValue;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8935
      otherwise, return the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8936
      This method is only redefined in UndefinedObject - therefore,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8937
      the recevier is retuned here.
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
      Thus, if foo and bar are simple variables or constants,
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8940
	  foo ? bar
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8941
      is the same as:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8942
	  (foo isNil ifTrue:[bar] ifFalse:[foo])
5755
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
      if they are message sends, the equivalent code is:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8945
	  [
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8946
	      |t1 t2|
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8947
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8948
	      t1 := foo.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8949
	      t2 := bar.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8950
	      t1 isNil ifTrue:[t2] ifFalse:[t1]
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8951
	  ] value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8952
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8953
      Can be used to provide defaultValues to variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8954
      as in:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8955
	  foo := arg ? #defaultValue
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8956
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8957
      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
  8958
      Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8959
	 This method is open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  8960
	 - redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8961
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8962
    ^ self
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
     1 ? #default
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8966
     nil ? #default
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8967
    "
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
    "Created: / 4.11.1996 / 20:36:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8970
    "Modified: / 19.5.1998 / 17:39:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8971
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8972
16126
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8973
?+ aOneArgBlock
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8974
     "a syntactic sugar-piece:
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8975
      aOneArgBlock is executed with self as argument
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8976
      if self is not nil.
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8977
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8978
      Note: this method should never be redefined in classes other than UndefinedObject.
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8979
     "
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8980
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8981
    ^ aOneArgBlock value:self
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8982
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8983
    "
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8984
     1 ?+ [:v| v + 5]
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8985
     nil ?+ [:v| v + 5]
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8986
    "
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8987
!
bd5dd5e03278 class: Object
Stefan Vogel <sv@exept.de>
parents: 16125
diff changeset
  8988
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8989
?? defaultValue
11634
657c12384132 Fix spelling
Stefan Vogel <sv@exept.de>
parents: 11573
diff changeset
  8990
     "a syntactic sugar-piece:
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8991
      much like ?, but sends #value to the argument if required.
15758
30c2f111a661 class: Object
Claus Gittinger <cg@exept.de>
parents: 15723
diff changeset
  8992
      (i.e. it's the same as #ifNil:)
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8993
      If the receiver is nil, return the defaultValues value;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8994
      otherwise, return the receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  8995
      This method is only redefined in UndefinedObject - therefore,
15758
30c2f111a661 class: Object
Claus Gittinger <cg@exept.de>
parents: 15723
diff changeset
  8996
      the receiver is retuned here.
5755
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
      Thus, if foo and bar are simple variables or constants,
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  8999
	  foo ?? bar
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9000
      is the same as:
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  9001
	  (foo isNil ifTrue:[bar value] ifFalse:[foo])
5755
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
      if they are message sends, the equivalent code is:
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  9004
	  [
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  9005
	      |t t2|
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  9006
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  9007
	      t := foo.
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  9008
	      t isNil ifTrue:[bar value] ifFalse:[t]
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  9009
	  ] value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9010
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9011
      Can be used to provide defaultValues to variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9012
      as in:
15932
61bf45ec26c9 fixed displayString for systems without libbasic2
Claus Gittinger <cg@exept.de>
parents: 15931
diff changeset
  9013
	  foo := arg ?? [ self computeDefault ]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9014
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9015
      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
  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
    ^ self
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9019
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9020
    "
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9021
     1 ?? #default
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9022
     nil ?? #default
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9023
     1 ?? [ self halt. 1 + 2 ]
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9024
     nil ?? [ self halt. 1 + 2 ]
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9025
     1 ?? [Date today]
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9026
     nil ?? [Date today]
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9027
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9028
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9029
    "Created: / 4.11.1996 / 20:36:19 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9030
    "Modified: / 19.5.1998 / 17:42:56 / cg"
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
ifNil:aBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9034
    "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
  9035
     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
  9036
     receiver.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9037
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9038
	This method is open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9039
	- redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9040
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9041
    ^ self
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9044
ifNil:nilBlockOrValue ifNotNil:notNilBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9045
    "return the value of the first arg, if I am nil,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9046
     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
  9047
     Notice:
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9048
	This method is open coded (inlined) by the compiler(s)
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9049
	- redefining it may not work as expected."
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  9050
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  9051
    (notNilBlockOrValue isBlock and:[notNilBlockOrValue argumentCount == 1]) ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9052
	^ notNilBlockOrValue value:self.
15501
43d3929a8fc0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15449
diff changeset
  9053
    ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9054
    ^ notNilBlockOrValue value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9055
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9056
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9057
ifNotNil:aBlockOrValue
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9058
    "return myself if nil, or the result from evaluating the argument,
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9059
     if I am not nil.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9060
     Notice:
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9061
	This method is open coded (inlined) by the compiler(s)
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9062
	- redefining it may not work as expected."
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  9063
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  9064
    (aBlockOrValue isBlock and:[aBlockOrValue argumentCount == 1]) ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9065
	^ aBlockOrValue value:self.
15501
43d3929a8fc0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15449
diff changeset
  9066
    ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9067
    ^ aBlockOrValue value
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9068
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9069
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9070
ifNotNil:notNilBlockOrValue ifNil:nilBlockOrValue
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9071
    "return the value of the 2nd arg, if I am nil,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9072
     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
  9073
     Notice:
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9074
	This method is open coded (inlined) by the compiler(s)
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9075
	- redefining it may not work as expected."
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  9076
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
  9077
    (notNilBlockOrValue isBlock and:[notNilBlockOrValue argumentCount == 1]) ifTrue:[
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
  9078
	^ notNilBlockOrValue value:self.
15501
43d3929a8fc0 class: Object
Claus Gittinger <cg@exept.de>
parents: 15449
diff changeset
  9079
    ].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9080
    ^ notNilBlockOrValue value
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
8574
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  9083
ifNotNilDo:aBlock
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  9084
    "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
  9085
     Otherwise do nothing and return nil."
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  9086
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  9087
    ^ aBlock value:self
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  9088
!
33bb637901eb *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8563
diff changeset
  9089
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9090
isArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9091
    "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
  9092
     false is returned here - the method is only redefined in Array."
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
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9095
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9096
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9097
isAssociation
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9098
    "return true, if the receiver is some kind of association;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9099
     false is returned here - the method is only redefined in Association."
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
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9102
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9103
    "Created: 14.5.1996 / 17:03:45 / cg"
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9106
isBehavior
18352
9f4843dad9d3 class: Object
Claus Gittinger <cg@exept.de>
parents: 18319
diff changeset
  9107
    "return true, if the receiver is describing another object's behavior.
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9108
     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
  9109
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9110
    ^ false
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9113
isBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9114
    "return true, if the receiver is some kind of block;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9115
     false returned here - the method is only redefined in Block."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9116
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9117
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9118
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9119
5824
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  9120
isBoolean
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  9121
    "return true, if the receiver is a boolean;
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  9122
     false is returned here - the method is only redefined in Boolean."
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  9123
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  9124
    ^ false
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  9125
!
fdf9cd50a141 Added method isBoolean; need this!
martin
parents: 5821
diff changeset
  9126
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9127
isByteArray
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9128
    "return true, if the receiver is some kind of bytearray;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9129
     false is returned here - the method is only redefined in ByteArray."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9130
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9131
    ^ false
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
8986
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  9134
isByteCollection
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  9135
    "return true, if the receiver is some kind of byte collection,
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9136
     i.e. #at: and #at:put: accesses a byte. This is different from 'self class isBytes',
8986
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  9137
     since e.g. in BitArray single bits are accessed, but it is implemented as variableBytes class.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9138
8986
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  9139
     false is returned here - the method is only redefined in UninterpretedBytes."
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  9140
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  9141
    ^ false
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  9142
!
c2962d45eca0 new: #isByteCollection
Stefan Vogel <sv@exept.de>
parents: 8977
diff changeset
  9143
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9144
isCharacter
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9145
    "return true, if the receiver is some kind of character;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9146
     false is returned here - the method is only redefined in Character."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9147
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9148
    ^ false
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9151
isClass
9405
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  9152
    "return true, if the receiver is some kind of class
cdeae08708cd comments
Stefan Vogel <sv@exept.de>
parents: 9375
diff changeset
  9153
     (real class, not just behavior);
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9154
     false is returned here - the method is only redefined in Class."
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
    ^ false
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
isCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9160
    "return true, if the receiver is some kind of collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9161
     false is returned here - the method is only redefined in Collection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9162
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9163
    ^ false
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
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9166
isColor
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9167
    "return true, if the receiver is some kind of color;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9168
     false is returned here - the method is only redefined in Color."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9169
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9170
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9171
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9172
6567
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9173
isCons
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9174
    "return true, if the receiver is a cons (pair);
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9175
     false is returned here - the method is only redefined in Cons."
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9176
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9177
    ^ false
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9178
!
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9179
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9180
isContext
15362
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9181
    "return true, if the receiver is some kind of Context;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9182
     false returned here - the method is only redefined in Context."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9183
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9184
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9185
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9186
15362
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9187
isDictionary
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9188
    "return true, if the receiver is some kind of dictionary;
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9189
     false returned here - the method is only redefined in Dictionary."
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9190
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9191
    ^ false
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9192
!
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9193
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  9194
isEmptyOrNil
8833
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  9195
    "return true if I am nil or an empty collection - return false here.
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  9196
     (from Squeak)"
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  9197
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  9198
    ^ false
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  9199
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  9200
    "Created: / 13.11.2001 / 13:17:04 / cg"
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  9201
    "Modified: / 13.11.2001 / 13:28:40 / cg"
6181
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  9202
!
5876cc789e41 + isEmptyOrNil
Claus Gittinger <cg@exept.de>
parents: 6175
diff changeset
  9203
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  9204
isException
15362
f64a9683658b class: Object
Claus Gittinger <cg@exept.de>
parents: 15255
diff changeset
  9205
    "answer true, if this is an Exception"
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9206
6221
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  9207
    ^ false
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  9208
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  9209
    "Created: / 17.11.2001 / 18:37:44 / cg"
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  9210
!
404495587300 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6203
diff changeset
  9211
6631
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9212
isExceptionCreator
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9213
    "return true, if the receiver can create exceptions,
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9214
     this includes #raise, #raiseRequest as well as the behavior of
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9215
     an exception handler, such as the #accepts: and #handles: messages"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9216
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9217
    ^ false
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9218
!
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9219
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9220
isExceptionHandler
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9221
    "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
  9222
     especially to the #accepts: and #handles: messages"
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9223
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9224
    ^ false
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9225
!
5ffa1ce7b2cc #isExceptionCreator instead of #isSignal
Stefan Vogel <sv@exept.de>
parents: 6600
diff changeset
  9226
13187
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9227
isExternalAddress
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9228
    "return true, if the receiver is some kind of externalAddress;
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9229
     false is returned here - the method is only redefined in ExternalAddress."
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9230
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9231
    ^ false
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9232
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9233
    "Created: / 22-12-2010 / 17:20:36 / cg"
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9234
!
f79a83bcc243 added: #isExternalAddress
Claus Gittinger <cg@exept.de>
parents: 13165
diff changeset
  9235
14079
4568576f2690 added: #isExternalBytes
Stefan Vogel <sv@exept.de>
parents: 14078
diff changeset
  9236
isExternalBytes
4568576f2690 added: #isExternalBytes
Stefan Vogel <sv@exept.de>
parents: 14078
diff changeset
  9237
    ^ false
4568576f2690 added: #isExternalBytes
Stefan Vogel <sv@exept.de>
parents: 14078
diff changeset
  9238
!
4568576f2690 added: #isExternalBytes
Stefan Vogel <sv@exept.de>
parents: 14078
diff changeset
  9239
10480
9fc4dd89edb2 +isExternalLibraryFunction
fm
parents: 10460
diff changeset
  9240
isExternalLibraryFunction
9fc4dd89edb2 +isExternalLibraryFunction
fm
parents: 10460
diff changeset
  9241
    "return true, if the receiver is some kind of externalLibrary function;
9fc4dd89edb2 +isExternalLibraryFunction
fm
parents: 10460
diff changeset
  9242
     false is returned here - the method is only redefined in ExternalLibraryFunction."
9fc4dd89edb2 +isExternalLibraryFunction
fm
parents: 10460
diff changeset
  9243
9fc4dd89edb2 +isExternalLibraryFunction
fm
parents: 10460
diff changeset
  9244
    ^false
9fc4dd89edb2 +isExternalLibraryFunction
fm
parents: 10460
diff changeset
  9245
!
9fc4dd89edb2 +isExternalLibraryFunction
fm
parents: 10460
diff changeset
  9246
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9247
isExternalStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9248
    "return true, if the receiver is some kind of externalStream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9249
     false is returned here - the method is only redefined in ExternalStream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9250
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9251
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9252
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9253
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9254
isFileStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9255
    "return true, if the receiver is some kind of fileStream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9256
     false is returned here - the method is only redefined in FileStream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9257
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9258
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9259
!
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
isFilename
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9262
    "return true, if the receiver is some kind of filename;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9263
     false is returned here - the method is only redefined in Filename."
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
    ^false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9266
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9267
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9268
isFixedPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9269
    "return true, if the receiver is some kind of fixedPoint number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9270
     false is returned here - the method is only redefined in FixedPoint."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9271
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9272
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9273
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9274
    "Created: 5.11.1996 / 19:23:04 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9275
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9276
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9277
isFixedSize
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9278
    "return true if the receiver cannot grow easily
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9279
     (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
  9280
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9281
    ^ true
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9282
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9283
6185
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9284
isFloat
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9285
    "return true, if the receiver is some kind of floating point number;
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9286
     false is returned here.
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9287
     Same as #isLimitedPrecisionReal, but a better name ;-)"
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9288
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9289
    ^ false
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9290
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9291
    "Modified: / 14.11.2001 / 14:57:46 / cg"
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9292
!
2029fdbadfde +isFloat
Claus Gittinger <cg@exept.de>
parents: 6182
diff changeset
  9293
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9294
isForm
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9295
    "return true, if the receiver is some kind of form;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9296
     false is returned here - the method is only redefined in Form."
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
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9299
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9300
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9301
isFraction
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9302
    "return true, if the receiver is some kind of fraction;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9303
     false is returned here - the method is only redefined in Fraction."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9304
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9305
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9306
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9307
9293
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  9308
isHierarchicalItem
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  9309
    "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
  9310
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  9311
    ^ false
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  9312
!
307bb63a9057 category change
Claus Gittinger <cg@exept.de>
parents: 9279
diff changeset
  9313
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9314
isImage
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9315
    "return true, if the receiver is some kind of image;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9316
     false is returned here - the method is only redefined in Image."
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
    ^ false
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
isImageOrForm
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9322
    "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
  9323
     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
  9324
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9325
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9326
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9327
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9328
isImmediate
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9329
    "return true if I am an immediate object
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9330
     i.e. I am represented in the pointer itself and
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9331
     no real object header/storage is used me.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9332
     (currently, only SmallIntegers, some characters and nil return true)"
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
    ^ self class hasImmediateInstances
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9335
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9336
    "Created: 3.6.1997 / 12:00:18 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9337
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9338
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9339
isInteger
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9340
    "return true, if the receiver is some kind of integer number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9341
     false is returned here - the method is only redefined in Integer."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9342
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9343
    ^ false
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
9279
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  9346
isInterestConverter
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  9347
    "return true if I am a kind of interest forwarder"
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  9348
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  9349
    ^ false
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  9350
!
90b74299a7c0 interest stuff
Claus Gittinger <cg@exept.de>
parents: 9246
diff changeset
  9351
10576
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9352
isInternalByteStream
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9353
    "return true, if the receiver is some kind of Stream for reading bytes;
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9354
     false is returned here - the method is only redefined in PeekableStream."
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9355
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9356
    ^false
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9357
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9358
    "Created: / 30-05-2007 / 16:15:33 / cg"
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9359
!
60526e4a6854 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10567
diff changeset
  9360
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9361
isJavaClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9362
    "return true, if this is a javaClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9363
     false is returned here - the method is only redefined in JavaClass."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9364
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9365
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9366
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9367
    "Created: / 26.3.1997 / 13:34:54 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9368
    "Modified: / 8.5.1998 / 21:25:21 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9369
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9370
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9371
isJavaClassRef
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9372
    "return true, if this is a JavaClassRef.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9373
     false is returned here - the method is only redefined in JavaClassRef."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9374
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9375
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9376
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9377
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9378
    "Created: / 24.12.1999 / 01:46:28 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9379
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9380
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9381
isJavaContext
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9382
    "return true, if this is a javaContext.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9383
     false is returned here - the method is only redefined in JavaContext."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9384
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9385
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9386
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9387
    "Created: / 8.5.1998 / 21:24:27 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9388
    "Modified: / 8.5.1998 / 21:25:35 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9389
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9390
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9391
isJavaMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9392
    "return true, if this is a JavaMethod.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9393
     false is returned here - the method is only redefined in JavaMethod."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9394
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9395
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9396
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9397
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9398
    "Created: / 25.9.1999 / 23:26:12 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9399
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9400
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9401
isJavaMethodRef
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9402
    "return true, if this is a JavaMethodRef.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9403
     false is returned here - the method is only redefined in JavaMethodRef."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9404
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9405
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9406
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9407
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9408
    "Created: / 23.12.1999 / 19:44:51 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9409
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9410
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9411
isJavaObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9412
    "return true, if this is a javaObject.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9413
     false is returned here - the method is only redefined in JavaObject."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9414
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9415
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9416
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9417
    "Created: / 26.3.1997 / 13:34:48 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9418
    "Modified: / 8.5.1998 / 21:25:46 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9419
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9420
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9421
isJavaScriptClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9422
    "return true, if this is a javaScriptClass.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9423
     false is returned here - the method is only redefined in JavaScriptClass."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9424
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9425
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9426
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9427
8935
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  9428
isJavaScriptMetaclass
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  9429
    "return true, if this is a javaScript Metaclass.
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  9430
     false is returned here - the method is only redefined in JavaScriptMetaclass."
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  9431
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  9432
    ^ false
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  9433
!
f770c55ba40e *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 8934
diff changeset
  9434
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9435
isKindOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9436
    "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
  9437
     subclasses, false otherwise.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9438
     Advice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9439
	use of this to check objects for certain attributes/protocol should
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9440
	be avoided; it limits the reusability of your classes by limiting use
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9441
	to instances of certain classes and fences you into a specific inheritance
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9442
	hierarchy.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9443
	Use check-methods to check an object for a certain attributes/protocol
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9444
	(such as #isXXXX, #respondsTo: or #isNumber).
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9445
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9446
	Using #isKindOf: is considered BAD STYLE.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9447
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9448
     Advice2:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9449
	Be aware, that using an #isXXX method is usually much faster than
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9450
	using #isKindOf:; because isKindOf: has to walk up all the superclass
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9451
	hierarchy, comparing every class on the way.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9452
	Due to caching in the VM, a call to #isXXX is normally reached via
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9453
	a single function call.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9454
     "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9455
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9456
%{  /* NOCONTEXT */
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9457
    register OBJ thisClass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9458
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9459
    thisClass = __Class(self);
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9460
    while (thisClass != nil) {
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9461
	if (thisClass == aClass) {
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9462
	    RETURN ( true );
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9463
	}
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9464
	thisClass = __ClassInstPtr(thisClass)->c_superclass;
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9465
    }
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9466
    RETURN ( false );
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9467
%}
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9468
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9469
"/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9470
"/  the above code is equivalent to:
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9471
"/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9472
"/  thisClass := self class.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9473
"/  [thisClass notNil] whileTrue:[
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9474
"/      thisClass == aClass ifTrue:[^ true].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9475
"/      thisClass := thisClass superclass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9476
"/  ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9477
"/  ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9478
"/
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9479
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9480
17168
1a65336dec3e class: Object
Claus Gittinger <cg@exept.de>
parents: 16907
diff changeset
  9481
isLabelAndIcon
1a65336dec3e class: Object
Claus Gittinger <cg@exept.de>
parents: 16907
diff changeset
  9482
    "return true, if the receiver is a labelAndIcon;
1a65336dec3e class: Object
Claus Gittinger <cg@exept.de>
parents: 16907
diff changeset
  9483
     false is returned here - the method is only redefined in LabelAndIcon."
1a65336dec3e class: Object
Claus Gittinger <cg@exept.de>
parents: 16907
diff changeset
  9484
1a65336dec3e class: Object
Claus Gittinger <cg@exept.de>
parents: 16907
diff changeset
  9485
    ^ false
1a65336dec3e class: Object
Claus Gittinger <cg@exept.de>
parents: 16907
diff changeset
  9486
!
1a65336dec3e class: Object
Claus Gittinger <cg@exept.de>
parents: 16907
diff changeset
  9487
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9488
isLayout
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9489
    "return true, if the receiver is some kind of layout;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9490
     false is returned here - the method is only redefined in Layout."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9491
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9492
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9493
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9494
6567
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9495
isLazyValue
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9496
    ^ false
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9497
!
cba5c3103600 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6549
diff changeset
  9498
6086
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  9499
isLimitedPrecisionReal
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  9500
    "return true, if the receiver is some kind of floating point number;
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  9501
     false is returned here - the method is only redefined in LimitedPrecisionReal."
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  9502
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  9503
    ^ false
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  9504
!
0bd476397581 added isLimitedPrecisionReal
Claus Gittinger <cg@exept.de>
parents: 6074
diff changeset
  9505
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9506
isList
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9507
    "return true, if the receiver is some kind of list collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9508
     false is returned here - the method is only redefined in List."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9509
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9510
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9511
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9512
    "Created: / 11.2.2000 / 01:37:05 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9513
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9514
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9515
isLiteral
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9516
    "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
  9517
     false is returned here - the method is redefined in some classes."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9518
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9519
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9520
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9521
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9522
isMemberOf:aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9523
    "return true, if the receiver is an instance of aClass, false otherwise.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9524
     Advice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9525
	use of this to check objects for certain attributes/protocol should
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9526
	be avoided; it limits the reusability of your classes by limiting use
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9527
	to instances of a certain class.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9528
	Use check-methods to check an object for a certain attributes/protocol
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9529
	(such as #isXXX, #respondsTo: or #isNumber);
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9530
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9531
	Using #isMemberOf: is considered BAD STYLE.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9532
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9533
	This method is open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9534
	- redefining it may not work as expected."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9535
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9536
    ^ (self class) == aClass
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9537
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9538
18319
a28d1c9dd31e class: Object
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  9539
isMenuItem
a28d1c9dd31e class: Object
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  9540
    "return true, if the receiver is a menu item inside a MenuPanel, Menu or PopUpmenu.
a28d1c9dd31e class: Object
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  9541
     false is returned here - the method is redefined in some classes."
a28d1c9dd31e class: Object
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  9542
a28d1c9dd31e class: Object
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  9543
    ^ false
a28d1c9dd31e class: Object
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  9544
!
a28d1c9dd31e class: Object
Claus Gittinger <cg@exept.de>
parents: 18289
diff changeset
  9545
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9546
isMeta
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9547
    "return true, if the receiver is some kind of metaclass;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9548
     false is returned here - the method is only redefined in Metaclass."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9549
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9550
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9551
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9552
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9553
isMethod
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9554
    "return true, if the receiver is some kind of method;
16021
301a3939838f class: Object
Claus Gittinger <cg@exept.de>
parents: 16012
diff changeset
  9555
     false returned here - this method is only redefined in Method."
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9556
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9557
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9558
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9559
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9560
isMorph
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9561
    "return true, if the receiver is some kind of morph;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9562
     false is returned here - the method is only redefined in Morph."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9563
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9564
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9565
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9566
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9567
isNameSpace
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9568
    "return true, if the receiver is a nameSpace.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9569
     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
  9570
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9571
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9572
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9573
    "Created: / 11.10.1996 / 18:08:56 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9574
    "Modified: / 8.5.1998 / 21:26:05 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9575
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9576
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9577
isNamespace
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9578
    "return true, if this is a nameSpace.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9579
     false is returned here - the method is only redefined in Namespace."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9580
5869
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  9581
    <resource:#obsolete>
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  9582
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9583
    self obsoleteMethodWarning:'use #isNameSpace'.
6805
f95ad1a82775 *** empty log message ***
ca
parents: 6800
diff changeset
  9584
    ^ self isNameSpace
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9585
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9586
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9587
isNil
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9588
    "Return true, if the receiver is nil.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9589
     Because isNil is redefined in UndefinedObject,
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9590
     the receiver is definitely not nil here, so unconditionally return false.
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9591
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9592
	This method is open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9593
	- redefining it may not work as expected."
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9594
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9595
    ^ false
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9596
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9597
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9598
isNilOrEmptyCollection
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  9599
    "return true if I am nil or an empty collection - false here.
8833
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  9600
     Obsolete, use isEmptyOrNil."
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  9601
717b01292d0e comments
Stefan Vogel <sv@exept.de>
parents: 8832
diff changeset
  9602
    <resource:#obsolete>
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9603
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9604
    ^ false
6182
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  9605
2b992cf865bc comment
Claus Gittinger <cg@exept.de>
parents: 6181
diff changeset
  9606
    "Modified: / 13.11.2001 / 13:28:06 / cg"
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9607
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9608
9005
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9609
isNonByteCollection
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9610
    "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
  9611
     false is returned here - the method is redefined in Collection and UninterpretedBytes."
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9612
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9613
    ^ false
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9614
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9615
    "
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9616
	21 isNonByteCollection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9617
	'abc' isNonByteCollection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9618
	#'abc' isNonByteCollection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9619
	#[1 2 3] isNonByteCollection
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9620
	#(1 2 3) isNonByteCollection
9005
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9621
    "
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9622
!
b82aa6bdc487 #isNonByteCollection
Stefan Vogel <sv@exept.de>
parents: 8986
diff changeset
  9623
16907
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9624
isNotNil
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9625
    "Return true, if the receiver not nil.
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9626
     Because isNotNil is redefined in UndefinedObject,
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9627
     the receiver is definitely not nil here, so unconditionally return true."
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9628
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9629
    ^ true
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9630
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9631
    "Created: / 26-10-2014 / 01:30:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9632
!
402df2d3c1d7 added: Object>>isNotNil
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 16828
diff changeset
  9633
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9634
isNumber
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9635
    "return true, if the receiver is some kind of number;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9636
     false is returned here - the method is only redefined in Number."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9637
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9638
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9639
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9640
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9641
isOrderedCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9642
    "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
  9643
     false is returned here - the method is only redefined in OrderedCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9644
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9645
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9646
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9647
16342
d0f27ca59145 class: Object
Stefan Vogel <sv@exept.de>
parents: 16325
diff changeset
  9648
isOsHandle
d0f27ca59145 class: Object
Stefan Vogel <sv@exept.de>
parents: 16325
diff changeset
  9649
    ^ false
d0f27ca59145 class: Object
Stefan Vogel <sv@exept.de>
parents: 16325
diff changeset
  9650
!
d0f27ca59145 class: Object
Stefan Vogel <sv@exept.de>
parents: 16325
diff changeset
  9651
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9652
isPoint
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9653
    "return true, if the receiver is some kind of point;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9654
     false is returned here - the method is only redefined in Point."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9655
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9656
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9657
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9658
10532
36237807e16a + #isPrinterContext
fm
parents: 10530
diff changeset
  9659
isPrinterContext
36237807e16a + #isPrinterContext
fm
parents: 10530
diff changeset
  9660
36237807e16a + #isPrinterContext
fm
parents: 10530
diff changeset
  9661
    ^false
36237807e16a + #isPrinterContext
fm
parents: 10530
diff changeset
  9662
!
36237807e16a + #isPrinterContext
fm
parents: 10530
diff changeset
  9663
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9664
isProgrammingLanguage
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9665
    "return true, if the receiver is a programming language.
14632
6fe0dc1d5377 64bit mingw changes
Claus Gittinger <cg@exept.de>
parents: 14539
diff changeset
  9666
     False is returned here - the method is only redefined in
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9667
     ProgrammingLanguage."
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9668
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9669
    ^ false
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9670
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9671
    "Created: / 21-07-2010 / 15:13:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9672
!
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
  9673
9515
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9674
isProjectDefinition
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9675
    "return true, if the receiver is a projectDefinition.
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9676
     False is returned here - the method is only redefined in ProjectDefinition."
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9677
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9678
    ^ false
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9679
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9680
    "Created: / 10-08-2006 / 16:24:53 / cg"
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9681
!
89c8275e009a *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9509
diff changeset
  9682
13140
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9683
isProxy
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9684
    "return true, if the receiver is a proxy for another (lazy loaded) object.
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9685
     False is returned here."
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9686
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9687
    ^ false
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9688
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9689
    "Created: / 21-11-2010 / 11:15:46 / cg"
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9690
!
919308f42885 added: #isProxy
Claus Gittinger <cg@exept.de>
parents: 13136
diff changeset
  9691
10171
523c654f762b +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10062
diff changeset
  9692
isRealNameSpace
15439
6e30547e7c1d class: Object
Claus Gittinger <cg@exept.de>
parents: 15407
diff changeset
  9693
    "return true, if the receiver is a nameSpace, but not Smalltalk (which is also a class).
6e30547e7c1d class: Object
Claus Gittinger <cg@exept.de>
parents: 15407
diff changeset
  9694
     False is returned here - the method is redefined in Namespace and Smalltalk."
10171
523c654f762b +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10062
diff changeset
  9695
523c654f762b +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10062
diff changeset
  9696
    ^ false
523c654f762b +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10062
diff changeset
  9697
523c654f762b +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10062
diff changeset
  9698
    "Created: / 10-11-2006 / 17:05:43 / cg"
523c654f762b +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10062
diff changeset
  9699
!
523c654f762b +isRealNameSpace
Claus Gittinger <cg@exept.de>
parents: 10062
diff changeset
  9700
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9701
isRectangle
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9702
    "return true, if the receiver is some kind of rectangle;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9703
     false is returned here - the method is only redefined in Rectangle."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9704
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9705
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9706
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9707
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9708
isRemoteObject
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9709
    "return true, if the receiver is some kind of remoteObject,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9710
     false if its local - the method is only redefined in RemoteObject."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9711
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9712
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9713
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9714
    "Created: 28.10.1996 / 15:18:45 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9715
    "Modified: 28.10.1996 / 15:20:57 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9716
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9717
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9718
isSequenceable
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9719
    "return true, if the receiver is some kind of sequenceable collection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9720
     false is returned here - the method is only redefined in SequenceableCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9721
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9722
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9723
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9724
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9725
isSequenceableCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9726
    "OBSOLETE: use isSequenceable for ST-80 compatibility.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9727
     This method is a historic leftover and will be removed soon ...
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9728
     (although its name is much better than #isSequenceable - sigh)"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9729
5869
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  9730
    <resource:#obsolete>
362be80efcb9 Use <resource:#obsolete>
Stefan Vogel <sv@exept.de>
parents: 5856
diff changeset
  9731
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9732
    self obsoleteMethodWarning:'use #isSequenceable'.
17365
b3c64ee9cbf5 class: Object
Claus Gittinger <cg@exept.de>
parents: 17306
diff changeset
  9733
    ^ self isSequenceable
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9734
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9735
10856
d54db15b9761 +isSharedPool
Claus Gittinger <cg@exept.de>
parents: 10837
diff changeset
  9736
isSharedPool
d54db15b9761 +isSharedPool
Claus Gittinger <cg@exept.de>
parents: 10837
diff changeset
  9737
    "return true, if the receiver is a sharedPool.
d54db15b9761 +isSharedPool
Claus Gittinger <cg@exept.de>
parents: 10837
diff changeset
  9738
     False is returned here - the method is only redefined in SharedPool."
d54db15b9761 +isSharedPool
Claus Gittinger <cg@exept.de>
parents: 10837
diff changeset
  9739
d54db15b9761 +isSharedPool
Claus Gittinger <cg@exept.de>
parents: 10837
diff changeset
  9740
    ^ false
d54db15b9761 +isSharedPool
Claus Gittinger <cg@exept.de>
parents: 10837
diff changeset
  9741
!
d54db15b9761 +isSharedPool
Claus Gittinger <cg@exept.de>
parents: 10837
diff changeset
  9742
16770
9ac0b20cef5f class: Object
Claus Gittinger <cg@exept.de>
parents: 16732
diff changeset
  9743
isSingleByteString
9ac0b20cef5f class: Object
Claus Gittinger <cg@exept.de>
parents: 16732
diff changeset
  9744
    "return true, if the receiver is a string or immutableString.
16772
429a8466520a class: Object
Claus Gittinger <cg@exept.de>
parents: 16770
diff changeset
  9745
     false is returned here - the method is only redefined in String.
429a8466520a class: Object
Claus Gittinger <cg@exept.de>
parents: 16770
diff changeset
  9746
     Must replace foo isMemberOf:String and foo class == String"
16770
9ac0b20cef5f class: Object
Claus Gittinger <cg@exept.de>
parents: 16732
diff changeset
  9747
9ac0b20cef5f class: Object
Claus Gittinger <cg@exept.de>
parents: 16732
diff changeset
  9748
    ^ false
9ac0b20cef5f class: Object
Claus Gittinger <cg@exept.de>
parents: 16732
diff changeset
  9749
!
9ac0b20cef5f class: Object
Claus Gittinger <cg@exept.de>
parents: 16732
diff changeset
  9750
15514
a9a6355f89d4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15501
diff changeset
  9751
isSocketAddress
a9a6355f89d4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15501
diff changeset
  9752
    ^ false
a9a6355f89d4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15501
diff changeset
  9753
!
a9a6355f89d4 class: Object
Stefan Vogel <sv@exept.de>
parents: 15501
diff changeset
  9754
13565
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9755
isSpecialInstrumentationInfoLiteral
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9756
    "return true, if the receiver is a special instrumentation info
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9757
     object as placed into the literal array of instrumented methods"
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9758
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9759
    ^ false
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9760
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9761
    "Created: / 07-08-2011 / 17:03:41 / cg"
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9762
!
4c0a9ea3a4e1 added: #isSpecialInstrumentationInfoLiteral
Claus Gittinger <cg@exept.de>
parents: 13515
diff changeset
  9763
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9764
isStream
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9765
    "return true, if the receiver is some kind of stream;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9766
     false is returned here - the method is only redefined in Stream."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9767
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9768
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9769
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9770
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9771
isString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9772
    "return true, if the receiver is some kind of string;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9773
     false is returned here - the method is only redefined in CharacterArray."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9774
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9775
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9776
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9777
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9778
isStringCollection
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9779
    "return true, if the receiver is some kind of stringCollection;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9780
     false is returned here - the method is only redefined in StringCollection."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9781
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9782
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9783
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9784
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9785
isSymbol
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9786
    "return true, if the receiver is some kind of symbol;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9787
     false is returned here - the method is only redefined in Symbol."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9788
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9789
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9790
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9791
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9792
isText
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9793
    "return true, if the receiver is some kind of text object;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9794
     false is returned here - the method is only redefined in Text."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9795
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9796
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9797
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9798
    "Created: 12.5.1996 / 10:56:50 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9799
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9800
13656
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9801
isTextView
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9802
    "return true, if the receiver is some kind of textView;
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9803
     false is returned here - the method is only redefined in TextViews."
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9804
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9805
    ^ false
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9806
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9807
    "Modified (comment): / 08-09-2011 / 05:12:37 / cg"
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9808
!
46e673aac938 added: #isTextView
Claus Gittinger <cg@exept.de>
parents: 13626
diff changeset
  9809
16349
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9810
isTimeDuration
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9811
    "return true, if the receiver is some kind of time duration;
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9812
     false is returned here - the method is only redefined in TimeDuration."
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9813
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9814
    ^ false
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9815
!
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9816
13229
187ab17bc43d added: #isTimestamp
Stefan Vogel <sv@exept.de>
parents: 13190
diff changeset
  9817
isTimestamp
16349
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9818
    "return true, if the receiver is some kind of time duration;
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9819
     false is returned here - the method is only redefined in Timestamp."
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9820
13229
187ab17bc43d added: #isTimestamp
Stefan Vogel <sv@exept.de>
parents: 13190
diff changeset
  9821
    ^ false
187ab17bc43d added: #isTimestamp
Stefan Vogel <sv@exept.de>
parents: 13190
diff changeset
  9822
!
187ab17bc43d added: #isTimestamp
Stefan Vogel <sv@exept.de>
parents: 13190
diff changeset
  9823
13626
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9824
isTrait
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9825
    "Return true if the receiver is a trait.
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9826
     Note: Do not override in any class except TraitBehavior."
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9827
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9828
    ^ false
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9829
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9830
    "Created: / 04-09-2011 / 20:04:43 / cg"
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9831
!
057aa930d735 added: #isTrait
Claus Gittinger <cg@exept.de>
parents: 13578
diff changeset
  9832
14296
fe82bc5091f9 added: #isUUID
Stefan Vogel <sv@exept.de>
parents: 14292
diff changeset
  9833
isUUID
16349
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9834
    "Return true if the receiver is a uuid.
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9835
     Note: Do not override in any class except UUID."
ef173d25b20c class: Object
Claus Gittinger <cg@exept.de>
parents: 16342
diff changeset
  9836
14296
fe82bc5091f9 added: #isUUID
Stefan Vogel <sv@exept.de>
parents: 14292
diff changeset
  9837
    ^ false
fe82bc5091f9 added: #isUUID
Stefan Vogel <sv@exept.de>
parents: 14292
diff changeset
  9838
!
fe82bc5091f9 added: #isUUID
Stefan Vogel <sv@exept.de>
parents: 14292
diff changeset
  9839
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9840
isValueModel
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9841
    "return true, if the receiver is some kind of valueModel;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9842
     false is returned here - the method is only redefined in ValueModel."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9843
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9844
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9845
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9846
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9847
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9848
isVariable
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9849
    "return true if the receiver has indexed instance variables,
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9850
     false otherwise."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9851
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9852
    ^ self class isVariable
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9853
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9854
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9855
isVariableBinding
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9856
    "return true, if this is a binding for a variable.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9857
     false is returned here - the method is only redefined in Binding."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9858
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9859
    ^ false
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9860
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9861
    "Created: / 19.6.1997 / 17:38:44 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9862
    "Modified: / 8.5.1998 / 21:26:55 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9863
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9864
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9865
isView
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9866
    "return true, if the receiver is some kind of view;
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9867
     false is returned here - the method is only redefined in View."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9868
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9869
    ^ false
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9870
!
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9871
15943
e232d88d7157 class: Object
Claus Gittinger <cg@exept.de>
parents: 15942
diff changeset
  9872
isViewBackground
e232d88d7157 class: Object
Claus Gittinger <cg@exept.de>
parents: 15942
diff changeset
  9873
    "return false here; to be redefined in subclass(es)"
e232d88d7157 class: Object
Claus Gittinger <cg@exept.de>
parents: 15942
diff changeset
  9874
e232d88d7157 class: Object
Claus Gittinger <cg@exept.de>
parents: 15942
diff changeset
  9875
    ^ false
e232d88d7157 class: Object
Claus Gittinger <cg@exept.de>
parents: 15942
diff changeset
  9876
!
e232d88d7157 class: Object
Claus Gittinger <cg@exept.de>
parents: 15942
diff changeset
  9877
6932
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  9878
notEmptyOrNil
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  9879
    "Squeak compatibility:
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  9880
     return true if I am neither nil nor an empty collection.
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  9881
     Return true here."
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  9882
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  9883
    ^ true
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  9884
!
1e1d296d4747 + #notEmptyOrNil
penk
parents: 6926
diff changeset
  9885
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9886
notNil
9221
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9887
    "Return true, if the receiver is not nil.
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9888
     Because notNil is redefined in UndefinedObject,
d8fff4a78065 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 9216
diff changeset
  9889
     the receiver is definitely not nil here, so unconditionally return true.
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9890
     Notice:
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9891
	This method is open coded (inlined) by the compiler(s)
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9892
	- redefining it may not work as expected."
6068
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9893
1d5ca1175f3f added #isNilOrEmptyCollection
Claus Gittinger <cg@exept.de>
parents: 6033
diff changeset
  9894
    ^ true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9895
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9896
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9897
!Object methodsFor:'tracing'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9898
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9899
traceInto:aRequestor level:level from:referrer
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9900
    "double dispatch into tracer, passing my type implicitely in the selector"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9901
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9902
    ^ aRequestor traceObject:self level:level from:referrer
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9903
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9904
    "Created: / 2.9.1999 / 09:05:17 / stefan"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9905
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9906
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9907
!Object methodsFor:'user interaction & notifications'!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9908
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9909
activityNotification:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9910
    "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
  9911
     some long-time activity.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9912
     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
  9913
     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
  9914
     and proceed. If there is no handler, this is simply ignored.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9915
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9916
     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
  9917
     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
  9918
     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
  9919
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  9920
    ActivityNotification isHandled ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9921
	^ ActivityNotification raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9922
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9923
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9924
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9925
     nil activityNotification:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9926
     self activityNotification:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9927
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9928
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9929
    "
8330
15ef95301861 Convert more instance based exceptions to class based exceptions
Stefan Vogel <sv@exept.de>
parents: 8324
diff changeset
  9930
     ActivityNotification handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9931
	ex errorString printCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9932
	ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9933
     ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9934
	'hello' printCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9935
	self activityNotification:'doing some long time computation'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9936
	'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9937
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9938
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9939
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9940
    "Modified: 16.12.1995 / 18:23:42 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9941
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9942
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9943
confirm:aString
9694
64f6face84d5 comment
Claus Gittinger <cg@exept.de>
parents: 9657
diff changeset
  9944
    "open a modal yes-no dialog.
64f6face84d5 comment
Claus Gittinger <cg@exept.de>
parents: 9657
diff changeset
  9945
     Return true for yes, false for no.
10527
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9946
     If no GUI is present (headless applications), true is returned.
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9947
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9948
     Someone in the sender chain may redefine the confirmation handler
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9949
     by handling the UserConfirmation."
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9950
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9951
    ^ UserConfirmation raiseRequestErrorString:aString
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9952
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9953
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9954
     nil confirm:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9955
     self confirm:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9956
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9957
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9958
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9959
confirm:aString orCancel:cancelBlock
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9960
    "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
  9961
     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
  9962
     If no GUI is present (headless applications), cancelBlock is returned."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9963
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9964
    |answer|
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9965
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9966
    answer := self confirmWithCancel:aString.
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9967
    answer isNil ifTrue:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
  9968
	^ cancelBlock value
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9969
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9970
    ^ answer
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9971
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9972
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9973
     self confirm:'hello' orCancel:[self halt]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9974
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9975
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9976
    "Modified: 20.5.1996 / 10:28:40 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9977
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9978
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9979
confirmWithCancel:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9980
    "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
  9981
     return true for yes, false for no, nil for cancel.
10527
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9982
     If no GUI is present (headless applications), nil is returned.
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9983
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9984
     Someone in the sender chain may redefine the confirmation handler
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9985
     by handling the UserConfirmation."
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
  9986
11366
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
  9987
    ^ self confirmWithCancel:aString defaultAnswer:nil
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9988
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9989
    "
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
  9990
     nil confirmWithCancel:'hello'
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9991
     self confirmWithCancel:'hello'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9992
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9993
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
  9994
11366
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
  9995
confirmWithCancel:aString defaultAnswer:defaultAnswerOrNil
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
  9996
    "launch a confirmer, which allows user to enter yes, no or cancel.
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
  9997
     return true for yes, false for no, nil for cancel.
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
  9998
     If no GUI is present (headless applications), nil is returned.
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
  9999
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10000
     Someone in the sender chain may redefine the confirmation handler
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10001
     by handling the UserConfirmation."
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10002
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10003
    ^ UserConfirmation new
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10004
	defaultAnswer:defaultAnswerOrNil;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10005
	canCancel:true;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10006
	errorString:aString;
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10007
	raiseRequest
11366
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10008
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10009
    "
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10010
     nil confirmWithCancel:'hello' defaultAnswer:true
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10011
     self confirmWithCancel:'hello' defaultAnswer:false
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10012
    "
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10013
!
97a8331d3e4c + confirmWithCancel defaultAnswer
Claus Gittinger <cg@exept.de>
parents: 11339
diff changeset
 10014
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10015
errorNotify:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10016
    "launch a Notifier, showing top stack, telling user something
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10017
     and give user a chance to enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10018
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10019
    ^ self
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10020
	errorNotify:aString
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10021
	from:thisContext sender
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10022
	allowDebug:true
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10023
	mayProceed:true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10024
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10025
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10026
     nil errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10027
     self errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10028
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10029
6199
5fcf06f17cee *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 6196
diff changeset
 10030
    "Modified: / 16.11.2001 / 15:36:49 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10031
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10032
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10033
errorNotify:aString from:aContext
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
 10034
    "launch a Notifier, showing top stack (above aContext),
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10035
     telling user something and give user a chance to enter debugger."
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10036
15255
62f7d4655ba8 class: Object
Stefan Vogel <sv@exept.de>
parents: 15243
diff changeset
 10037
    ^ self errorNotify:aString from:aContext allowDebug:true mayProceed:true
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10038
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10039
    "Modified: / 17.8.1998 / 10:09:27 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10040
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10041
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10042
errorNotify:aString from:aContext allowDebug:allowDebug
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
 10043
    "launch a Notifier, showing top stack (above aContext),
15255
62f7d4655ba8 class: Object
Stefan Vogel <sv@exept.de>
parents: 15243
diff changeset
 10044
     telling user something and give user a chance to enter debugger."
62f7d4655ba8 class: Object
Stefan Vogel <sv@exept.de>
parents: 15243
diff changeset
 10045
62f7d4655ba8 class: Object
Stefan Vogel <sv@exept.de>
parents: 15243
diff changeset
 10046
    ^ self errorNotify:aString from:aContext allowDebug:allowDebug mayProceed:true
62f7d4655ba8 class: Object
Stefan Vogel <sv@exept.de>
parents: 15243
diff changeset
 10047
!
62f7d4655ba8 class: Object
Stefan Vogel <sv@exept.de>
parents: 15243
diff changeset
 10048
62f7d4655ba8 class: Object
Stefan Vogel <sv@exept.de>
parents: 15243
diff changeset
 10049
errorNotify:aString from:aContext allowDebug:allowDebug mayProceed:mayProceed
62f7d4655ba8 class: Object
Stefan Vogel <sv@exept.de>
parents: 15243
diff changeset
 10050
    "launch a Notifier, showing top stack (above aContext),
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10051
     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
 10052
11314
0b6e06b60ebe changed the error-notifier for standAlone apps.
Claus Gittinger <cg@exept.de>
parents: 11244
diff changeset
 10053
    |currentScreen con sender action boxLabels boxValues default s|
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10054
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10055
    Smalltalk isInitialized ifFalse:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10056
	'errorNotification: ' print. aString printCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10057
	con := aContext ? thisContext methodHome.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10058
	con sender printAllLevels:10.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10059
	^ nil
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
 10060
    ].
11531
30f1ba816a81 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11530
diff changeset
 10061
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
 10062
    (Dialog isNil
6647
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
 10063
     or:[Screen isNil
79c298b93c07 #errorNotify -- allow copying the backtrace
Stefan Vogel <sv@exept.de>
parents: 6631
diff changeset
 10064
     or:[(currentScreen := Screen current) isNil
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
 10065
     or:[currentScreen isOpen not]]]) ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10066
	"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10067
	 on systems without GUI, simply show
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10068
	 the message on the Transcript and abort.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10069
	"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10070
	Transcript showCR:aString.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10071
	AbortOperationRequest raise.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10072
	"not reached"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10073
	^ nil
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10074
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10075
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10076
    Processor activeProcessIsSystemProcess ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10077
	action := #debug.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10078
	sender := aContext.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10079
	Debugger isNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10080
	    '****************** Caught Error while in SystemProcess ****************' errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10081
	    aString errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10082
	    Exception handle:[:ex |
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10083
		'Caught recursive error while printing backtrace:' errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10084
		ex description errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10085
	    ] do:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10086
		thisContext fullPrintAll.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10087
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10088
	    action := #abort.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10089
	].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10090
    ] ifFalse:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10091
	Dialog autoload.        "in case it's autoloaded"
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10092
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10093
	Error handle:[:ex |
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10094
	    "/ a recursive error - quickly enter debugger
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10095
	    "/ this happened, when I corrupted the Dialog class ...
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10096
	    ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10097
	    action := #debug.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10098
	    ex return.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10099
	] do:[ |s|
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10100
	    sender := aContext.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10101
	    sender isNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10102
		sender := thisContext methodHome sender.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10103
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10104
	    con := sender.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10105
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10106
	    "/ skip intermediate (signal & exception) contexts
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10107
	    DebugView notNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10108
		con := DebugView interestingContextFrom:sender
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10109
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10110
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10111
	    "/ show the first few contexts
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10112
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10113
	    s := CharacterWriteStream with:aString.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10114
	    s cr; cr.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10115
	    s nextPutLine:'Calling Chain:'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10116
	    s nextPutLine:'--------------------------------------------------------------'.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10117
	    1 to:25 do:[:n |
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10118
		con notNil ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10119
		    con printOn:s.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10120
		    s cr.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10121
		    con := con sender
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10122
		]
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10123
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10124
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10125
	    mayProceed ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10126
		boxLabels := #('Proceed').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10127
		boxValues := #(#proceed).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10128
		default := #proceed.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10129
	    ] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10130
		boxLabels := #().
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10131
		boxValues := #().
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10132
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10133
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10134
	    AbortOperationRequest isHandled ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10135
		default := #abort.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10136
		boxLabels := boxLabels , #('Abort').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10137
		boxValues := boxValues , #(#abort).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10138
		AbortAllOperationRequest isHandled ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10139
		    boxLabels := boxLabels , #('Abort All').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10140
		    boxValues := boxValues , #(#abortAll).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10141
		].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10142
		true "allowDebug" ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10143
		    boxLabels := boxLabels , #('Copy Trace and Abort').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10144
		    boxValues := boxValues , #(#copyAndAbort).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10145
		].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10146
	    ] ifFalse:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10147
		mayProceed "and:[allowDebug]" ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10148
		    boxLabels := boxLabels , #('Copy Trace and Proceed').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10149
		    boxValues := boxValues , #(#copyAndProceed).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10150
		].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10151
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10152
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10153
	    (allowDebug and:[Debugger notNil]) ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10154
		boxLabels := boxLabels , #('Debug').
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10155
		boxValues := boxValues , #(#debug).
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10156
		default := #debug.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10157
	    ].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10158
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10159
	    action := Dialog
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10160
		    choose:s contents
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10161
		    label:('Exception [' , Processor activeProcess nameOrId , ']')
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10162
		    image:WarningBox errorIconBitmap
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10163
		    labels:boxLabels
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10164
		    values:boxValues
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10165
		    default:default
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10166
		    onCancel:nil.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10167
	].
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10168
    ].
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10169
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10170
    action == #debug ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10171
	^ Debugger enter:sender withMessage:aString mayProceed:mayProceed
11236
c196f9dedf66 exception description in debugger
Claus Gittinger <cg@exept.de>
parents: 11221
diff changeset
 10172
    ].
c196f9dedf66 exception description in debugger
Claus Gittinger <cg@exept.de>
parents: 11221
diff changeset
 10173
    action == #proceed ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10174
	^ nil.
11335
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
 10175
    ].
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
 10176
    (action == #copyAndProceed
c061d08b766f *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 11314
diff changeset
 10177
    or:[action == #copyAndAbort]) ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10178
	s := '' writeStream.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10179
	Exception handle:[:ex |
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10180
	    'Caught recursive error while printing backtrace' errorPrintCR.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10181
	] do:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10182
	    sender fullPrintAllOn:s.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10183
	].
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10184
	currentScreen rootView setClipboardText:s contents.
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10185
	action == #copyAndProceed ifTrue:[
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10186
	    ^ nil
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10187
	].
17306
29dcfbfb331c class: Object
Claus Gittinger <cg@exept.de>
parents: 17261
diff changeset
 10188
    ].
29dcfbfb331c class: Object
Claus Gittinger <cg@exept.de>
parents: 17261
diff changeset
 10189
    (action == #abortAll) ifTrue:[
18215
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10190
	AbortAllOperationRequest raise
5940d5eff81b java preps
Claus Gittinger <cg@exept.de>
parents: 18185
diff changeset
 10191
    ].
11314
0b6e06b60ebe changed the error-notifier for standAlone apps.
Claus Gittinger <cg@exept.de>
parents: 11244
diff changeset
 10192
11236
c196f9dedf66 exception description in debugger
Claus Gittinger <cg@exept.de>
parents: 11221
diff changeset
 10193
    AbortOperationRequest raise.
c196f9dedf66 exception description in debugger
Claus Gittinger <cg@exept.de>
parents: 11221
diff changeset
 10194
    "not reached"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10195
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10196
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10197
     nil errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10198
     self errorNotify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10199
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10200
13165
66a6b37405d1 changed: #errorNotify:from:allowDebug:
Claus Gittinger <cg@exept.de>
parents: 13162
diff changeset
 10201
    "Created: / 17-08-1998 / 10:09:26 / cg"
13566
fc4e1055263d changed: #errorNotify:from:allowDebug:
sr
parents: 13565
diff changeset
 10202
    "Modified: / 08-08-2011 / 11:26:17 / sr"
13844
f03a655457f4 changed: #errorNotify:from:allowDebug:
Claus Gittinger <cg@exept.de>
parents: 13812
diff changeset
 10203
    "Modified: / 05-12-2011 / 03:50:59 / cg"
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10204
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10205
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10206
information:aString
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
 10207
    "launch an InfoBox, telling user something.
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
 10208
     These info-boxes can be suppressed by handling
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10209
     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
 10210
     Use #notify: for more important messages.
8371
4493f5ac7405 *** empty log message ***
ca
parents: 8330
diff changeset
 10211
     If nobody handles the exception, the default action of UserNotification
10527
b783c0000f54 #confirm: now uses the UserConfirmation otification to request an answer
Stefan Vogel <sv@exept.de>
parents: 10480
diff changeset
 10212
     pops up an info dialog."
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10213
7035
1d049fb7ae5a Make UserInformation a class based exception
Stefan Vogel <sv@exept.de>
parents: 7033
diff changeset
 10214
    UserInformation raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10215
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10216
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10217
     nil information:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10218
     self information:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10219
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10220
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10221
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10222
     InformationSignal handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10223
	'no box popped' printCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10224
	ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10225
     ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10226
	'hello' printCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10227
	self information:'some info'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10228
	'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10229
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10230
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10231
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10232
    "Modified: 24.11.1995 / 22:29:49 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10233
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10234
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10235
notify:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10236
    "launch a Notifier, telling user something.
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10237
     Use #information: for ignorable messages.
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10238
     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
 10239
     pops up a warn dialog."
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10240
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10241
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10242
    Smalltalk isInitialized ifFalse:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10243
	"/ thisContext fullPrintAll.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10244
	'information: ' print. aString printCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10245
	^ self
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10246
    ].
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10247
    UserNotification raiseRequestWith:self errorString:aString.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10248
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10249
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10250
     nil notify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10251
     self notify:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10252
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10253
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10254
    "Modified: 20.5.1996 / 10:28:48 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10255
!
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10256
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10257
warn:aString
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10258
    "launch a WarningBox, telling user something.
10460
8495429eba05 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 10457
diff changeset
 10259
     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
 10260
     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
 10261
     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
 10262
     pops up a warn dialog."
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10263
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10264
    Warning raiseRequestWith:self errorString:aString
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10265
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10266
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10267
     nil warn:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10268
     self warn:'hello there'
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10269
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10270
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10271
    "
7033
c4183ea85a71 Now Warning is a subclass of UserNotification.
Stefan Vogel <sv@exept.de>
parents: 7031
diff changeset
 10272
     Warning handle:[:ex |
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10273
	Transcript showCR:ex description.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10274
	ex proceed.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10275
     ] do:[
15586
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10276
	'hello' printCR.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10277
	self warn:'some info'.
ac2e51b3000c class: Object
Claus Gittinger <cg@exept.de>
parents: 15519
diff changeset
 10278
	'world' printCR.
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10279
     ]
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10280
    "
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10281
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10282
    "Modified: 20.5.1996 / 10:28:53 / cg"
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10283
! !
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10284
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
 10285
!Object methodsFor:'visiting'!
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
 10286
8426
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
 10287
acceptVisitor:aVisitor
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
 10288
    "double-dispatch onto a Visitor."
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
 10289
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
 10290
    ^ self acceptVisitor:aVisitor with:nil
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
 10291
!
b4195c5f9450 +acceptVisitor
Claus Gittinger <cg@exept.de>
parents: 8413
diff changeset
 10292
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
 10293
acceptVisitor:aVisitor with:aParameter
16732
4ba89483ebfa comment/format only
Claus Gittinger <cg@exept.de>
parents: 16591
diff changeset
 10294
    "double-dispatch via visitObject:with: into a Visitor.
4ba89483ebfa comment/format only
Claus Gittinger <cg@exept.de>
parents: 16591
diff changeset
 10295
     Subclasses redefine this to pass their type in the message name (i.e. visitXXX:)"
8397
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
 10296
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
 10297
    ^ aVisitor visitObject:self with:aParameter
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
 10298
! !
a1cff241e853 Generalize visitor pattern and define #visit...:with: -methods instead
Stefan Vogel <sv@exept.de>
parents: 8383
diff changeset
 10299
18440
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
 10300
dc5cde224664 class: Object
Stefan Vogel <sv@exept.de>
parents: 18422
diff changeset
 10301
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10302
!Object class methodsFor:'documentation'!
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
 10303
14056
24d7f7bf46c7 inspector2TabForBasicInspect
Claus Gittinger <cg@exept.de>
parents: 14055
diff changeset
 10304
version
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
 10305
    ^ '$Header$'
14056
24d7f7bf46c7 inspector2TabForBasicInspect
Claus Gittinger <cg@exept.de>
parents: 14055
diff changeset
 10306
!
24d7f7bf46c7 inspector2TabForBasicInspect
Claus Gittinger <cg@exept.de>
parents: 14055
diff changeset
 10307
12050
bd0013f79e4f added: #notYetImplemented
Claus Gittinger <cg@exept.de>
parents: 11976
diff changeset
 10308
version_CVS
18620
b4e9f25d6ce6 preparations for lined index list in WeakArray
Claus Gittinger <cg@exept.de>
parents: 18440
diff changeset
 10309
    ^ '$Header$'
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
 10310
!
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
 10311
18259
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
 10312
version_HG
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
 10313
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
 10314
    ^ '$Changeset: <not expanded> $'
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
 10315
!
e8ad15456505 Added Object>>flag: for Squeak compatibility.
Jan Vrany <jan.vrany@fit.cvut.cz>
parents: 18237
diff changeset
 10316
13416
6eb7ca0bdd35 Jan's changes
vrany
parents: 13350
diff changeset
 10317
version_SVN
15243
8b2249151890 class: Object
Stefan Vogel <sv@exept.de>
parents: 15222
diff changeset
 10318
    ^ '$ Id: Object.st 10643 2011-06-08 21:53:07Z vranyj1  $'
1
a27a279701f8 Initial revision
claus
parents:
diff changeset
 10319
! !
6764
c5455cf45678 perform:withOptional*
Claus Gittinger <cg@exept.de>
parents: 6741
diff changeset
 10320
14661
2a5c79daa934 class: Object
Stefan Vogel <sv@exept.de>
parents: 14632
diff changeset
 10321
5755
72551e427a2d *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 5754
diff changeset
 10322
Object initialize!