Source

newspeak / ActivationMirrors.ns3

The default branch has multiple heads

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
Newspeak3
'Mirrors'
class ActivationMirrors usingPlatform: platform <Platform> = NewspeakObject (
"Mirrors for method activations and processes.

Copyright (c) 2009 Peter von der Ahe
Copyright (c) 2011 Gilad Bracha, Ryan Macnak and Cadence Design Systems

Permission is hereby granted, free of charge, to any person obtaining
a copy of this software and associated documentation files (the
''Software''), to deal in the Software without restriction, including
without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to
permit persons to whom the Software is furnished to do so, subject to
the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE."|
	OutOfScopeNotification = platform OutOfScopeNotification.
	Project = platform System Project.
	SystemMetadata = platform NewsqueakMixins SystemMetadata.
	DebuggerMethodMap = platform DebuggerMethodMap.

	mirrors = platform mirrors.
	MixinBuilder = mirrors MixinBuilder.
	MixinMirror = mirrors MixinMirror.
	MethodMirror = mirrors MethodMirror.
	activationMirrors = self.

	"Modules"
	vmMirror = platform SqueakVmMirror usingPlatform: platform .
	Language = platform Language.
|)
(
class ActivationMirror onContext: ctxt <ContextPart> = (|
	protected context_slot = ctxt.
	protected sender_slot
	protected home_slot
	protected sourceMap_slot
	protected methodNode_slot
	protected localNames_slot
	protected definingClass_slot
	protected methodMirror_slot
|)
('as yet unclassified'
activationsDo: action <[ActivationMirror]> = (
	| currentMirror |
	currentMirror:: self.
	[currentMirror isNil] whileFalse:
		[action value: currentMirror.
		currentMirror:: currentMirror sender]
)
compile: newSource ifFail: onFail ^ <NS2MethodMirror> = (
	self subclassResponsibility.
)
definingClass  ^ <Class> = (
	definingClass_slot ifNil:
		[definingClass_slot:: home ifNotNil:
			[:it |
			self == it
				ifTrue: [definingClassOf: homeMethod methodClass]
				ifFalse: [it definingClass]]].
	^definingClass_slot
)
definingClassOf: cls = (
	^cls mixin definingClass
)
errorReportOn: stream = (
	context_slot errorReportOn: stream
)
evaluate: expression <String> ifFail: onFail <[String]> ^<ObjectMirror> = (
	"| requestor |
	requestor:: SyntaxListener ifFail:
		[:msg |
		^onFail valueWithPossibleArgument: msg]."
	[
		| newValue |
		newValue:: definingClass theNonMetaClass language compiler new
			evaluate: expression
			in: context_slot
			to: receiver
			notifying: "requestor" nil
			ifFail: [^onFail valueWithPossibleArgument: 'Error'].
		^vmMirror reflectOn: newValue
	] on: OutOfScopeNotification do: [:ex | ex resume: true]
)
hasActivation: activation <ActivationMirror> ^ <Boolean> = (
	^context_slot hasSender: activation context_slot
)
home ^ <ActivationMirror> = (
	^isBlockMirror
		ifTrue:
			[home_slot ifNil:
				[context_slot home ifNotNil:
					[:it | home_slot:: class onContext: it]].
			home_slot]
		ifFalse:
			[self]
)
homeInThread ^ <ActivationMirror> = (
	isBlockMirror ifFalse: [^self].
	home ifNotNil:
		[:homeMirror <ActivationMirror>  |
		(hasActivation: homeMirror) ifTrue:
			[activationsDo:
				[:each <ActivationMirror> |
				each context_slot == homeMirror context_slot ifTrue: [^each]]]].
	^nil
)
homeMethod ^ <CompiledMethod> = (
	^home ifNotNil:
		[:it |
		self == it
			ifTrue: [context_slot method]
			ifFalse: [it homeMethod]]
)
isBlockMirror^ <Boolean> = (
	^isBlueBookBlock or: [isCogClosureActivation]
)
isBlueBookBlock ^ <Boolean> = (
	^context_slot isBlock
)
isCogClosureActivation ^ <Boolean> = (
	^context_slot isBlock not and: [context_slot closure notNil]
)
isMessageNotUnderstood  ^ <Boolean> = (
	^selector = #doesNotUnderstand:
)
isSenderOf: activation <ActivationMirror> ^ <Boolean> = (
	^(self == activation sender_slot)
		or: [context_slot == activation context_slot sender]
)
localNames ^ <List[String]>= (
  subclassResponsibility
)
localNamesWithValuesDo: action <[String, ObjectMirror]> = (
	localNames with: (1 to: localNames size) do:
		[:localName :i |
		action
			value: localName
			value: (vmMirror reflectOn: ([home context_slot at: i] ifError: ['<error getting value>']))]
)
methodMirror ^ <NS2MethodMirror> = (
	methodMirror_slot ifNil:[methodMirror_slot:: MethodMirror reflecting: homeMethod].
	^methodMirror_slot
)
methodNode ^ <MethodNode> = (
	methodNode_slot ifNil:
		[methodNode_slot:: homeMethod ifNotNil: [:it | it methodNode]].
	^methodNode_slot
)
nilMirror ^ <ObjectMirror> = (
	^vmMirror reflectOn: nil
)
notUnderstoodArguments = (
	^(context_slot tempAt: 1) arguments
)
notUnderstoodMessage ^ <Symbol> = (
	^(context_slot tempAt: 1) selector
)
pc = (
	^context_slot pc
)
pcRange  ^ <Interval> = (
	| actualPc <Integer>  i <Integer>  end <Integer> |
	"receiverClass language isNewspeakLanguage3 ifTrue: [
		#BOGUS yourself. 
		^1 to: 0
	]."
	
	(methodNode isNil or: [sourceMap isNil or: [sourceMap size = 0 or: [pc isNil]]])
		ifTrue: [^1 to: 0].
	actualPc:: pc -2. "Why?"	
	i:: sourceMap indexFor: actualPc -> nil.
	i < 1 ifTrue: [^1 to: 0].
	i > sourceMap size ifTrue:
		[end:: sourceMap inject: 0 into:
			[:acc :each | acc max: each value last].
		^end + 1 to: end].
	^(sourceMap at: i) value
)
printOn: s = (
	isBlockMirror
		ifTrue:
			[home ifNotNil:
				[:it |
				s nextPutAll: '[] in '.
				it printOn: s.
				^self].
			s nextPutAll: '<<Orphaned block>>']
		ifFalse:
			[homeMethod ifNotNil:
				[:it | | cls n |
				cls:: definingClassOf: receiver class.
				n:: cls simpleName.
				s nextPutAll: n.
				(definingClass isNil or: [definingClass == cls or: [n = definingClass simpleName]])
					ifFalse:
						[s nextPut: $(.
						s nextPutAll: definingClass simpleName.
						s nextPut: $)].
				s space.
				s nextPutAll: (selector ifNil: [it defaultSelector]).
				isMessageNotUnderstood ifTrue:
					[s space.
					notUnderstoodMessage printOn: s].
				^self].
			s nextPutAll: '<<Anonymous method>>']
)
proposedMissingMessageSource ^ <String> = (
	| message args |
	isMessageNotUnderstood ifFalse: [^''].
	message:: notUnderstoodMessage.
	args:: notUnderstoodArguments.
	message isUnary
		ifTrue: [message:: message, ' ']
		ifFalse:
			[message:: String streamContents:
				[:s |
				message keywords withIndexDo:
					[:each :i |
					s nextPutAll: each.
					s space.
					s nextPutAll: 'argument'.
					s nextPutAll: i asString.
					s space.
					s nextPut: $<.
					putInferredTypeOf: (args at: i) on: s.
					s nextPut: $>.
					s space]]].

	^receiverClass language isNewspeakLanguage3
		ifTrue: [message asString, '= (\	\)' withCRs]
		ifFalse: [message asString]
)
putInferredTypeOf: arg on: s <Stream> = (
	arg isBehavior ifTrue: [^s nextPutAll: 'Class'].
	arg isBlock ifTrue:
		[s nextPut: $[.
		(1 to: arg argumentCount)
			do: [:ignored | s nextPutAll: '_, '].
		s space.
		^s nextPutAll: '^_]'].
	s nextPutAll: (definingClassOf: arg class) simpleName
)
receiver = (
	^context_slot receiver
)
receiverClass ^ <Class> = (
	^definingClassOf: receiver class
)
receiverMirror ^ <ObjectMirror> = (
	^vmMirror reflectOn: receiver
)
refresh = (
	sender_slot ifNotNil:
		[:it |
		it context_slot == context_slot sender
			ifFalse: [sender_slot:: nil]].
	home_slot:: nil.
	sourceMap_slot:: nil.
	methodNode_slot:: nil.
	localNames_slot:: nil.
)
selector ^ <Symbol> = (
	^context_slot selector
)
sender ^ <ActivationMirror> = (
	sender_slot ifNil:
		[context_slot sender ifNotNil:
			[:it | sender_slot:: (ActivationMirror reflecting: it)]].
	^sender_slot
)
setLocalVariable: variableName <String> to: exprString <String> ifFail: onFail <[String]> ^<Object> = (
	| index newValue <ObjectMirror> |
	index:: localNames indexOf: variableName ifAbsent:
		[variableName asInteger asString = variableName asString
			ifTrue: [variableName asInteger + localNames size]].
	(index isNil or: [index < 1 or: [index > stackDepth]])
		ifTrue: [^onFail valueWithPossibleArgument: 'Not found: ', variableName].
	newValue:: evaluate: exprString ifFail:
		[:msg | ^onFail valueWithPossibleArgument: msg].
	newValue withReflecteeDo: [:it | home context_slot at: index put: it].
)
source = (
	^sourceAvailable
		ifTrue: [homeMethod getSource]
		ifFalse: ['No source available']
)
sourceAvailable = (
	^(homeMethod properties includesKey: #source) 
		or: [homeMethod getSourceFromFile notNil]
)
sourceMap ^ <SortedList[Association[Integer, Interval]]>= (
  subclassResponsibility
)
stackDepth ^ <Integer> = (
	isCogClosureActivation ifTrue: [^context_slot size].
	^home context_slot size
)
stackIndicesWithValuesDo: action <[Integer, ObjectMirror]> = (

	| tempFrameSize |
"	receiverClass language isNewspeakLanguage3 ifTrue: [
		#BOGUS yourself.
		tempFrameSize:: 0.	
	] ifFalse: ["
		tempFrameSize: localNames size.
	"]."

	stackDepth to: tempFrameSize + 1 by: -1 do:
		[:i |
		action
			value: i - localNames size
			value: (vmMirror reflectOn: (context_slot at: i))]
)'private'
relateTo: activation <ActivationMirror> = (
	"Called by a thread mirror after the stack has changed as a consequence of executing or simulating instructions.

This activation represents the new stack top aka. current activation."
	| current |

	(activation isSenderOf: self)
		ifTrue: [sender_slot: activation refresh. ^self].

	"Activation represent a sender further up the stack."
	(hasActivation: activation)
		ifTrue: [sender relateTo: activation refresh. ^self].

	"See if self represents an activation further up the stack from activation and use existing mirror."
	current:: activation.
	[current context_slot == context_slot ifTrue: [^current refresh].
	current sender_slot isNil]
		whileFalse: [current:: current sender_slot].

	activation refresh.
)) : ('as yet unclassified'
reflecting: c <ContexPart> ^ <Instance> = (

	^c method methodClass language activationMirrorFor: c using: activationMirrors
))
class ActivationMirrorCompiledByNewspeak onContext: c <ContextPart> = ActivationMirror onContext: c (
"A mirror on activations whose code was produced by the Newspeak compiler (NS3 and above)."|
	private lowLevelMethodMirror_slot
	private debugMapper_slot
|assert: [c isMethodContext]
	message: 'NS3+ does not generate BlockContext blocks, so it should always have MethodContext activations')
('as yet unclassified'
compile: newSource ifFail: onFail ^ <NS2MethodMirror> = (
	| builder newSelector declMirror mixinMirror |

	builder:: MixinBuilder reflecting: definingClass mixin.
	newSelector:: (builder methods addFromSource: newSource) simpleName.
	declMirror:: builder declaration install.

	mixinMirror:: builder isMeta
		ifTrue: [declMirror classSide]
		ifFalse: [declMirror instanceSide].	

	^mixinMirror methods findMirrorNamed: newSelector.
)
debugMapper = (
	debugMapper_slot ifNil: [
		debugMapper_slot:: lowLevelMethodMirror debugInfo mapperForContext: context_slot
	].
	^debugMapper_slot
)
evaluate: expression <String> ifFail: onFail <[String]> ^<old ObjectMirror> = (

	"Expects old mirror answer"
	^vmMirror reflectOn: (evalute: expression) reflectee
)
evalute: expression <String> ^<ObjectMirror> = (

	| cls mxn mtdMirror result |
	cls:: mirrors vmmirror classOf: receiver.
	mxn:: MixinMirror reflecting: cls mixin.
	mtdMirror:: mirrors compiler
		compileExpressionSource: expression readStream
		inContext: context_slot
		inMixin: mxn declaration. 
		
	mtdMirror metadata at: #category put: 'DoIts'.
	mtdMirror klass: cls mixin definingClass.
	
	result:: mirrors vmmirror 
		object: receiver
		executeMethod: mtdMirror compiledMethod
		with: {context_slot}
		ifFail: [primitiveFailed].

	^mirrors ObjectMirror reflecting: result
)
localNames ^ <List[String]>= (

	sourceAvailable ifFalse: [^{}].

	localNames_slot ifNil: [
		localNames_slot:: debugMapper localNames 
	].
	^localNames_slot
)
localNamesWithValuesDo: action <[String, ObjectMirror]> = (

	localNames do: [:ea | action value: ea value: 
		(vmMirror reflectOn: ([debugMapper getValueOf: ea] 
			ifError: ['<error getting value>']))].
)
lowLevelMethodMirror ^ <LowLevelMethodMirror>= (
	lowLevelMethodMirror_slot ifNil:[
		| mixinMirror <MixinMirror> |
		mixinMirror:: MixinMirror reflecting: definingClass mixin.
		lowLevelMethodMirror_slot:: 
			Language newspeak3 compiler new compiler compileMethodSource: methodMirror source readStream within: mixinMirror declaration.
	].
	^lowLevelMethodMirror_slot
)
pcRange ^<Interval> = (
	sourceAvailable ifFalse: [^1 to: 0].
	^lowLevelMethodMirror debugInfo sourceMapping at: pc ifAbsent: [1 to: 0].
)
stackIndicesWithValuesDo: action <[Integer, ObjectMirror]> = (
	| tempFrameSize |
	#BOGUS yourself.
	"Need to specialize.  The operand stack isn't simply after the number of locals in scope because remote temps don't take one slot each on the stacks of nested-closures."

	tempFrameSize: localNames size "+ hidden itvs, setters, pushnils".

	stackDepth to: tempFrameSize + 1 by: -1 do:
		[:i |
		action
			value: i - tempFrameSize
			value: (vmMirror reflectOn: (context_slot at: i))]
))
class ActivationMirrorCompiledBySqueak onContext: ctxt = ActivationMirror onContext: ctxt (
"A mirror that operates on activations whose code was compiled by the Squeak back-end. This includes code produced by the Smalltalk, NS0, NS1 and NS2 compilers."|
	methodMap_slot
|)
('as yet unclassified'
compile: newSource ifFail: onFail ^ <NS2MethodMirror> = (

	| klass newSelector newCM |
	klass:: definingClass.
	newSelector:: klass
		compile: newSource 
		classified: 'as-yet-unclassified'
		notifying: nil.
	newCM:: klass compiledMethodAt: newSelector.

	^MethodMirror reflecting: newCM
)
localNames ^ <SequenceableCollection[String]>= (
	localNames_slot ifNil: [		
		"localNames_slot:: methodNode ifNotNil: [:it | it tempNames]"
		localNames_slot:: methodMap tempNamesForContext: context_slot
	].
	^localNames_slot ifNil: [{}]
)
localNamesWithValuesDo: action <[String, ObjectMirror]> = (
	localNames with: (1 to: localNames size) do:
		[:localName :i |
		action
			value: localName
			value: (vmMirror reflectOn: (methodMap namedTempAt: i in: context_slot))]
)
methodMap ^<DebuggerMethodMap> = (
	methodMap_slot ifNil: [
		methodMap_slot:: DebuggerMethodMap forMethod: homeMethod.
	].
	^methodMap_slot
)
methodNode ^ <MethodNode> = (
	methodNode_slot ifNil:
		[methodNode_slot:: homeMethod ifNotNil: [:it | it methodNode]].
	^methodNode_slot
)
pcRange  ^ <Interval> = (
	#BOGUS yourself. "How to tell if active context?  We don't have access to the Process from here."

	^context_slot debuggerMap 
		rangeForPC: pc
		contextIsActiveContext: false 
)
sourceMap ^ <SortedList[Association[Integer, Interval]]> = (
	sourceMap_slot ifNil:
		[sourceMap_slot:: methodNode ifNotNil: [:it | it sourceMap]].
	^sourceMap_slot
))
class SyntaxListener ifFail: handler <[String]> = (|
	onFail = handler.
|)
('as yet unclassified'
bindingOf: variableName <String> = (
	error: variableName asString, ' undeclared'
)
error: message <String> = (
	onFail value: message
)
isKindOf: ignored = (
	^false
)
notify: message <String> = (
	error: message
)
notify: message <String> at: location <Integer> = (
	error: message
)
notify: message <String> at: location <Integer> in: stream <ReadStream> = (
	error: message
)
requestor = (
	^#error:
)
selectFrom: ignored1 to: ignored2 = (
	error: 'Error'
)
selection = (
	^nil
)
selectionInterval = (
	^1 to: 0
))
class ThreadMirror on: process <Process> = (
"Represents a thread of control."|
	protected squeakProcess = process.
	protected wasMorphic = Project uiProcess == process.
|)
('accessing'
name = (
	^wasMorphic
		ifTrue: ['UI event loop']
		ifFalse: ['thread ', squeakProcess name].
)
summary = (
	^name, ' @ priority ', squeakProcess priority asString
)'as yet unclassified'
activationFor: newContext <ContextPart> relativeTo: activation <ActivationMirror> = (
	"Find the activation mirror corresponding to the given context, or create a new mirror."
	| newActivation |

	"Same context"
	newContext == activation context_slot
		ifTrue: [^activation refresh].

	"Returned to sender"
	activation sender ifNotNil:
		[:it |
		newContext ==  it context_slot
			ifTrue: [^it refresh]].

	^(ActivationMirror reflecting: newContext)
		relateTo: activation
)
install: method <NS2MethodMirror> restart: activation <ActivationMirror> ifFail: onFail = (
	| newContext |
	activation sender. "Remember sender"
	activation ifNil: [^onFail value: 'Block''s method not on stack'].
	newContext:: squeakProcess popTo: activation context_slot.
	newContext == activation context_slot ifFalse:
		[onFail value: 'Method saved, but error during unwind.'.
		^activationFor: newContext relativeTo: activation].
	squeakProcess
		restartTopWith: method reflectee;
		stepToSendOrReturn.
	^activation refresh
)
restart: activation <ActivationMirror> ^<ActivationMirror> = (
	| newContext |
	activation sender. "Remember sender"
	newContext:: squeakProcess popTo: activation context_slot.
	newContext == activation context_slot ifTrue:
		[newContext:: squeakProcess restartTop; stepToSendOrReturn].
	^activationFor: newContext relativeTo: activation
)
return: mirror <ObjectMirror> from: activation <ActivationMirror> ^<ActivationMirror> = (
	mirror withReflecteeDo:
		[:it |
		squeakProcess popTo: activation sender context_slot value: it].
	^activation sender refresh
)
stepInto: activation <ActivationMirror> ^<ActivationMirror> = (
	activation sender. "Remember sender"
	squeakProcess step: activation context_slot.
	^activationFor: squeakProcess stepToSendOrReturn relativeTo: activation.
)
stepIntoBlock: activation <ActivationMirror> ^<ActivationMirror> = (
	activation sender. "Remember sender"
	squeakProcess stepToHome: activation context_slot.
	^activationFor: squeakProcess stepToSendOrReturn relativeTo: activation.
)
stepOver: activation <ActivationMirror> ^ <ActivationMirror> = (
	| newContext |
	activation sender. "Remember sender"
	newContext:: squeakProcess completeStep: activation context_slot.
	newContext == activation context_slot ifTrue:
		[newContext:: squeakProcess stepToSendOrReturn].
	^activationFor: newContext  relativeTo: activation
)
unwindRecursion: activation <ActivationMirror> ^<ActivationMirror> = (
	| newContext |
	activation sender. "Remember sender"
	newContext:: squeakProcess popTo: activation context_slot findSecondToOldestSimilarSender.
	^activationFor: newContext relativeTo: activation
)'printing'
printOn: stream = (
	stream
		nextPutAll: 'ThreadMirror:';
		nextPutAll: name
)'testing'
isActiveThread = (
	^squeakProcess isActiveProcess
)'thread control'
resume = (
	| oldUiProcess |
	wasMorphic
		ifTrue:
			[oldUiProcess:: Project uiProcess.
			Project resumeProcess: squeakProcess]
		ifFalse:
			[squeakProcess resume].
	wasMorphic ifTrue: [oldUiProcess terminate]
)
suspend = (
	"Special case for the Morphic UI thread. NsFFISessionManager takes care of native UI thread."
	Project spawnNewProcessIfThisIsUI: squeakProcess.

	squeakProcess suspend.
)
terminate = (
	Project spawnNewProcessIfThisIsUI: squeakProcess.
	squeakProcess terminate
))'accessing'
onContext: context <ContextPart> ^ <ActivationMirror> = (
	assert: [context isNil not] message: 'context is nil'.
	^ActivationMirror reflecting: context
)
onProcess: process <Process> ^ <ThreadMirror> = (
	assert: [process isNil not] message: 'process is nil'.
	^ThreadMirror on: process
))