--- a/InstrumentationContext.st	Thu Aug 11 18:25:09 2011 +0200
+++ b/InstrumentationContext.st	Wed Aug 17 16:32:52 2011 +0200
@@ -13,7 +13,8 @@
 
 Object variableSubclass:#InstrumentationContext
 	instanceVariableNames:'inInstrumentedCode enabled'
-	classVariableNames:''
+	classVariableNames:'CachedProcessToInstrumentationContextMapping
+		GlobalInstrumentationContext'
 	poolDictionaries:''
 	category:'System-Compiler-Instrumentation'
 !
@@ -57,23 +58,51 @@
 !InstrumentationContext class methodsFor:'instance access'!
 
 current
-    "the current context for this running thread."
-
-    |p context|
+    "the current context for this running thread.
+     walks along the parent-process chain, up to a possible global context"
 
-    p := Processor activeProcess.
-    [p notNil] whileTrue:[
-        context := p environmentAt:#instrumentationContext ifAbsent:nil.
-        context notNil ifTrue:[^ context ].
-        p := p parentProcess
-    ].
-    ^ nil
+    ^ self forProcess:(Processor activeProcess)
 
     "
      InstrumentationContext current
     "
 
     "Created: / 08-08-2011 / 14:44:11 / cg"
+!
+
+forProcess:aProcess
+    "the context for this thread.
+     walks along the parent-process chain, up to a possible global context"
+
+    |p context|
+
+    CachedProcessToInstrumentationContextMapping isNil ifTrue:[
+        CachedProcessToInstrumentationContextMapping := WeakIdentityDictionary new.
+    ].
+
+    context := CachedProcessToInstrumentationContextMapping at:aProcess ifAbsent:nil.
+    context == 0 ifTrue:[ ^ nil].   "/ special entry for a known nil value
+    context isNil ifTrue:[
+        "/ future (need a faster parentProcess query)
+        p := aProcess.
+        [p notNil] whileTrue:[
+            context := p environmentAt:#instrumentationContext ifAbsent:nil.
+            context notNil ifTrue:[
+                CachedProcessToInstrumentationContextMapping at:aProcess put:context.
+                ^ context
+            ].
+            p := p parentProcess
+        ].
+        CachedProcessToInstrumentationContextMapping at:aProcess put:(GlobalInstrumentationContext ? 0). "/ known to be nil
+        context := GlobalInstrumentationContext.
+    ].
+    ^ context
+
+    "
+     InstrumentationContext current
+    "
+
+    "Created: / 17-08-2011 / 11:29:51 / cg"
 ! !
 
 !InstrumentationContext class methodsFor:'running'!
@@ -97,6 +126,17 @@
     "Created: / 08-08-2011 / 15:47:10 / cg"
 ! !
 
+!InstrumentationContext class methodsFor:'utilities'!
+
+setInstrumentationContext:aContextOrNil in:aProcess
+    "in order to keep the knowledge about which environment-variable is used
+     at least local..."
+
+    aProcess environmentAt:#instrumentationContext put:aContextOrNil
+
+    "Created: / 17-08-2011 / 11:53:19 / cg"
+! !
+
 !InstrumentationContext methodsFor:'accessing'!
 
 enabled
@@ -139,7 +179,7 @@
 beActiveIn:aProcess
     "become the current instrumentaion context for a process."
 
-    aProcess environmentAt:#instrumentationContext put:self.
+    self class setInstrumentationContext:self in:aProcess
 
     "
      InstrumentationContext new beActiveIn:(Processor activeProcess)
@@ -161,20 +201,26 @@
 run:aBlock
     "run aBlock with instrumentation enabled"
 
+    |activeProcess|
+
+    activeProcess := Processor activeProcess.
+
     [
-        self beActiveIn:(Processor activeProcess).
+        self beActiveIn:activeProcess.
         aBlock value
     ] ensure:[
-        Processor activeProcess environmentAt:#instrumentationContext put:nil
+        self class setInstrumentationContext:nil in:activeProcess
     ].
+
+    "Modified: / 17-08-2011 / 11:53:54 / cg"
 ! !
 
 !InstrumentationContext class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.2 2011-08-09 21:27:03 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.3 2011-08-17 14:32:52 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.2 2011-08-09 21:27:03 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libcomp/InstrumentationContext.st,v 1.3 2011-08-17 14:32:52 cg Exp $'
 ! !