Adds a simple callgraph browser without icons for the instrumentation status. Makes the selection of colors in the probe morphs more resilient

Author: codeZeilen

packages/Babylonian-Core.package/BPByteCodeCallgraphTracer.class/instance/enter.invocation..st

@@ -5,6 +5,6 @@ enter: aString invocation: aNumber
 	events nextPut: #enter.
 	events nextPut: aString.
 	events nextPut: aNumber.
-	senderContext := thisContext sender sender sender.
+	"senderContext := thisContext sender sender sender.
 	events nextPut: senderContext pc.
-	events nextPut: senderContext method.
+	events nextPut: senderContext method."

packages/Babylonian-Core.package/BPByteCodeCallgraphTracer.class/instance/eventsForTree.st

@@ -46,8 +46,8 @@ eventsForTree
 			blockIdx := parts third asInteger.
 			"invocation count of the surrounding method. In other words: 'Id' of the context of this block/method, unique per method"
 			invocationCount := eventStream next.
-			senderPC := eventStream next.
-			senderMethod := eventStream next.
+			"senderPC := eventStream next.
+			senderMethod := eventStream next."
 
 			entry := BPCallgraphEntryEnter new.
 			entry class: class selector: selector blockIdx: blockIdx invocationCount: invocationCount senderPC: senderPC senderMethod: senderMethod.

packages/Babylonian-Core.package/BPByteCodeCallgraphTracer.class/instance/eventsToString.st

@@ -26,8 +26,8 @@ eventsToString
 				blockIdx := parts third asInteger.
 				"invocation count of the surrounding method. In other words: 'Id' of the context of this block/method, unique per method"
 				invocationCount := eventStream next.
-				senderPC := eventStream next.
-				senderMethod := eventStream next.
+				"senderPC := eventStream next.
+				senderMethod := eventStream next."
 
 				stringStream 
 					nextPutAll: class;

packages/Babylonian-Core.package/BPByteCodeCallgraphTracer.class/methodProperties.json

@@ -11,10 +11,10 @@
 	"instance" : {
 		"blockIdxFromContext:" : "cmfcmf 1/4/2021 12:37",
 		"customEvent:data:" : "cmfcmf 10/23/2020 14:56",
-		"enter:invocation:" : "pre 1/21/2021 15:14",
+		"enter:invocation:" : "pre 2/15/2021 10:52",
 		"eventStream" : "cmfcmf 10/20/2020 13:49",
-		"eventsForTree" : "pre 1/20/2021 17:46",
-		"eventsToString" : "pre 1/20/2021 17:47",
+		"eventsForTree" : "pre 2/15/2021 10:53",
+		"eventsToString" : "pre 2/15/2021 10:53",
 		"eventsToStringForTest" : "cmfcmf 10/7/2020 14:07",
 		"exit:invocation:returns:" : "cmfcmf 10/20/2020 13:47",
 		"initialize" : "cmfcmf 12/5/2020 14:15",

packages/Babylonian-Core.package/BPByteCodeRewriter.class/class/shouldNeverInstrument.selector..st

@@ -4,11 +4,12 @@ shouldNeverInstrument: aClass selector: aSymbol
 	"largely copied from MwMethodWrapper class >> #canWrap:inClass:"
 	| class method |
 	(aClass category beginsWith: 'Babylonian-') ifTrue: [
-		aClass category ~= 'Babylonian-Tests-Callgraph-ByteCode-Fixtures' ifTrue: [^ true]].
+		({'Babylonian-Tests-Callgraph-ByteCode-Fixtures' . 'Babylonian-Demo-TreeScene'} includes: aClass category) 
+			ifFalse: [^ true]].
 
 	{{CompiledMethod . {#valueWithReceiver:arguments:}}.
 	  {BlockClosure . {#value . #ensure}}.
-	  {WriteStream . {#nextPut:}}} anySatisfy: [:tuple |
+	  {WriteStream . {#nextPut:}}} do: [:tuple |
 		((aClass includesBehavior: tuple first) and: [tuple second anySatisfy: [:excludedSelector | 
 				excludedSelector == aSymbol]]) ifTrue: [^ true]].
 
@@ -18,7 +19,7 @@ shouldNeverInstrument: aClass selector: aSymbol
 	  {DynamicVariable . {"only check for the class ;)"}}.
 	  {BPByteCodeMethodState . {"only check for the class ;)"}}.
 	  {BPByteCodeAssociation . {"only check for the class ;)"}}
-	 } anySatisfy: [:tuple |
+	 } do: [:tuple |
 		((aClass theNonMetaClass includesBehavior: tuple first) and: [tuple second isEmpty or: 
 			[tuple second anySatisfy: [:excludedSelector | excludedSelector == aSymbol]]]) 
 				ifTrue: [^ true]].

packages/Babylonian-Core.package/BPByteCodeRewriter.class/methodProperties.json

@@ -40,7 +40,7 @@
 		"rewriteClosureCreationByteCodeFor:withEncoder:numArgs:numTemps:" : "cmfcmf 10/11/2020 11:27",
 		"rewriteHeaderOf:numTemps:" : "cmfcmf 10/12/2020 18:22",
 		"setup" : "cmfcmf 10/7/2020 15:34",
-		"shouldNeverInstrument:selector:" : "pre 1/22/2021 16:40",
+		"shouldNeverInstrument:selector:" : "pre 2/15/2021 10:45",
 		"teardown" : "cmfcmf 10/7/2020 15:31",
 		"uninstallWrapper:" : "cmfcmf 10/29/2020 13:06",
 		"uninstrumentAll" : "cmfcmf 12/10/2020 12:43",

packages/Babylonian-Core.package/BPCallgraph.class/instance/detect..st

@@ -1,4 +1,4 @@
 enumerating
 detect: aBlock
 
-	^ self detect: aBlock ifFound: [:entry | ^ entry] ifNone: [self errorNotFound: aBlock]
+	^ self detect: aBlock ifFound: [:entry | ^ entry] ifNone: [self error: aBlock asString]

packages/Babylonian-Core.package/BPCallgraph.class/methodProperties.json

@@ -6,7 +6,7 @@
 		"allInvocationsOf:" : "cmfcmf 11/3/2020 13:57",
 		"babylonianEntries" : "cmfcmf 10/28/2020 11:01",
 		"commonAncestorOf:ignoringInvocationCounts:" : "cmfcmf 1/4/2021 13:26",
-		"detect:" : "cmfcmf 11/2/2020 14:20",
+		"detect:" : "pre 2/15/2021 10:21",
 		"detect:after:" : "cmfcmf 10/27/2020 16:26",
 		"detect:after:ifFound:ifNone:" : "cmfcmf 10/27/2020 16:25",
 		"detect:before:" : "cmfcmf 1/4/2021 19:22",

packages/Babylonian-Core.package/BPExampleTraceInformation.class/instance/callgraph.st

@@ -4,4 +4,4 @@ callgraph
 	callgraph ifNotNil: [^ callgraph].
 	^ callgraphTracer ifNotNil: [
 		callgraph := callgraphTracer eventsForTree.
-		callgraphTracer := nil]
+		"callgraphTracer := nil"]

packages/Babylonian-Core.package/BPExampleTraceInformation.class/methodProperties.json

@@ -2,7 +2,7 @@
 	"class" : {
 		 },
 	"instance" : {
-		"callgraph" : "pre 2/15/2021 10:04",
+		"callgraph" : "pre 2/15/2021 10:27",
 		"callgraphTracer" : "cmfcmf 11/9/2020 15:09",
 		"callgraphTracer:" : "cmfcmf 11/9/2020 15:32",
 		"terminateTracingProcess" : "cmfcmf 11/9/2020 17:00",

packages/Babylonian-Core.package/BPMethodExample.class/instance/run.st

@@ -1,6 +1,11 @@
 tracing
 run
 
-	^ self newReceiver 
+	| receiver arguments |
+	BPByteCodeCallgraphTracer deactivateDuring: [#bpInstrumented withoutLayerDo: [
+		receiver := self newReceiver.
+		arguments := self newArguments]].
+	
+	^ receiver 
 		perform: self method selector 
-		withArguments: self newArguments
+		withArguments: arguments

packages/Babylonian-Core.package/BPMethodExample.class/methodProperties.json

@@ -22,4 +22,4 @@
 		"receiverConstructor:" : "pre 5/17/2019 14:06",
 		"receiverConstructorString" : "pre 9/28/2020 12:03",
 		"resolveLiveSpecimen:" : "jb 12/1/2020 14:22",
-		"run" : "pre 1/21/2021 17:18" } }
+		"run" : "pre 2/15/2021 11:13" } }

packages/Babylonian-Core.package/BlockNode.extension/instance/additionalSize..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/additionalSize. (bpCallgraph).st

@@ -2,15 +2,15 @@
 	"class" : {
 		 },
 	"instance" : {
-		"additionalSize:" : "2/15/2021 09:53:45",
-		"additionalSizeBeforeBlock:" : "2/15/2021 09:53:45",
-		"emitCodeForEvaluatedClosureValue:encoder:" : "2/15/2021 09:53:45",
-		"emitCodeForEvaluatedFullClosureValue:encoder:" : "2/15/2021 09:53:45",
-		"emitCodeForEvaluatedValue:encoder:" : "2/15/2021 09:53:45",
-		"emitCodeForValue:encoder:" : "2/15/2021 09:53:45",
-		"isRootBlock:" : "2/15/2021 09:53:45",
-		"litIndexBlockIdentifier:" : "2/15/2021 09:53:45",
-		"sizeCodeForEvaluatedClosureValue:" : "2/15/2021 09:53:45",
-		"sizeCodeForEvaluatedFullClosureValue:" : "2/15/2021 09:53:45",
-		"sizeCodeForEvaluatedValue:" : "2/15/2021 09:53:45",
-		"sizeCodeForValue:" : "2/15/2021 09:53:45" } }
+		"additionalSize: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"additionalSizeBeforeBlock: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"emitCodeForEvaluatedClosureValue:encoder: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"emitCodeForEvaluatedFullClosureValue:encoder: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"emitCodeForEvaluatedValue:encoder: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"emitCodeForValue:encoder: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"isRootBlock: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"litIndexBlockIdentifier: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"sizeCodeForEvaluatedClosureValue: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"sizeCodeForEvaluatedFullClosureValue: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"sizeCodeForEvaluatedValue: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"sizeCodeForValue: (bpCallgraph)" : "1/22/2021 16:40:39" } }

packages/Babylonian-Core.package/BlockNode.extension/instance/additionalSizeBeforeBlock..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/additionalSizeBeforeBlock. (bpCallgraph).st

@@ -3,4 +3,4 @@
 		 },
 	"instance" : {
 		"genNops:" : "cmfcmf 11/27/2020 13:40",
-		"generateMethodOfClass:trailer:from:" : "2/15/2021 09:53:45" } }
+		"generateMethodOfClass:trailer:from: (bpCallgraph)" : "1/22/2021 16:40:39" } }

packages/Babylonian-Core.package/BlockNode.extension/instance/emitCodeForEvaluatedClosureValue.encoder..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/emitCodeForEvaluatedClosureValue.encoder. (bpCallgraph).st

@@ -2,5 +2,5 @@
 	"class" : {
 		 },
 	"instance" : {
-		"generate:using:" : "2/15/2021 09:53:45",
-		"rememberNOPs:range:blockId:" : "2/15/2021 09:53:45" } }
+		"generate:using: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"rememberNOPs:range:blockId: (bpCallgraph)" : "1/22/2021 16:40:39" } }

packages/Babylonian-Core.package/BlockNode.extension/instance/emitCodeForEvaluatedFullClosureValue.encoder..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/emitCodeForEvaluatedFullClosureValue.encoder. (bpCallgraph).st

@@ -2,15 +2,15 @@
 	"class" : {
 		 },
 	"instance" : {
-		"additionalReturnSize:returns:" : "2/15/2021 09:53:45",
-		"emitCodeForReturn:encoder:" : "2/15/2021 09:53:45",
-		"emitNOPs:stack:n:type:" : "2/15/2021 09:53:45",
-		"findEnclosingNonOptimizedBlock:" : "2/15/2021 09:53:45",
-		"findEnclosingNonOptimizedBlockId:" : "2/15/2021 09:53:45",
-		"invocationTempIndex:" : "2/15/2021 09:53:45",
-		"litIndexBlockIdentifier:" : "2/15/2021 09:53:45",
-		"litIndexEnterInvocation:" : "2/15/2021 09:53:45",
-		"litIndexExitInvocation:" : "2/15/2021 09:53:45",
-		"litIndexInvocationCount:" : "2/15/2021 09:53:45",
-		"litIndexTracerClass:" : "2/15/2021 09:53:45",
-		"sizeCodeForReturn:" : "2/15/2021 09:53:45" } }
+		"additionalReturnSize:returns: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"emitCodeForReturn:encoder: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"emitNOPs:stack:n:type: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"findEnclosingNonOptimizedBlock: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"findEnclosingNonOptimizedBlockId: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"invocationTempIndex: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"litIndexBlockIdentifier: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"litIndexEnterInvocation: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"litIndexExitInvocation: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"litIndexInvocationCount: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"litIndexTracerClass: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"sizeCodeForReturn: (bpCallgraph)" : "1/22/2021 16:40:39" } }

packages/Babylonian-Core.package/BlockNode.extension/instance/emitCodeForEvaluatedValue.encoder..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/emitCodeForEvaluatedValue.encoder. (bpCallgraph).st

@@ -2,5 +2,5 @@
 	"class" : {
 		 },
 	"instance" : {
-		"emitCodeForReturn:encoder:" : "2/15/2021 09:53:45",
-		"sizeCodeForReturn:" : "2/15/2021 09:53:45" } }
+		"emitCodeForReturn:encoder: (bpCallgraph)" : "1/22/2021 16:40:39",
+		"sizeCodeForReturn: (bpCallgraph)" : "1/22/2021 16:40:39" } }

packages/Babylonian-Core.package/BlockNode.extension/instance/emitCodeForValue.encoder..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/emitCodeForValue.encoder. (bpCallgraph).st

@@ -10,4 +10,4 @@ actualExampleList
 			writing browsers is boring --pre"
 			(anExample isActive 
 				ifTrue: ['aaa'] 
-				ifFalse: ['xxx']) , anExample exampleName]]
+				ifFalse: ['xxx']) , anExample exampleName] ascending]

packages/Babylonian-Core.package/BlockNode.extension/instance/isRootBlock..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/isRootBlock. (bpCallgraph).st

@@ -2,4 +2,4 @@ accessing
 actualPackageList
 
 	^ packageList ifNil: [packageList := (SystemNavigation default allExamples collect: [:anExample | 
-			anExample method methodClass package]) asSet sorted: [:aPackage | aPackage name]]
+			anExample method methodClass package]) asSet sorted: [:aPackage | aPackage name] ascending]

packages/Babylonian-Core.package/BlockNode.extension/instance/litIndexBlockIdentifier..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/litIndexBlockIdentifier. (bpCallgraph).st

@@ -2,8 +2,8 @@
 	"class" : {
 		"open" : "pre 10/13/2020 15:15" },
 	"instance" : {
-		"actualExampleList" : "jb 12/3/2020 22:55",
-		"actualPackageList" : "jb 12/3/2020 23:33",
+		"actualExampleList" : "pre 2/15/2021 10:29",
+		"actualPackageList" : "pre 2/15/2021 10:29",
 		"buildExamplesListWith:" : "pre 10/13/2020 14:49",
 		"buildPackagesListWith:" : "pre 10/13/2020 14:45",
 		"buildWith:" : "pre 10/13/2020 14:51",

packages/Babylonian-Core.package/BlockNode.extension/instance/sizeCodeForEvaluatedClosureValue..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/sizeCodeForEvaluatedClosureValue. (bpCallgraph).st

@@ -0,0 +1,10 @@
+class initialization
+initialize
+	
+	"self initialize"
+	self environment at: #TheWorldMenu ifPresent: [:menu |
+		(menu respondsTo: #registerOpenCommand:) ifTrue: [
+			menu unregisterOpenCommand: 'Babylonian Call-Graph Browser'.
+			menu registerOpenCommand: {'Babylonian Call-Graph Browser'. {self. #open}}]].
+	
+	Smalltalk addToStartUpList: self.

packages/Babylonian-Core.package/BlockNode.extension/instance/sizeCodeForEvaluatedFullClosureValue..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/sizeCodeForEvaluatedFullClosureValue. (bpCallgraph).st

@@ -0,0 +1,6 @@
+callgraph context menus
+messageIconFor: aSelector
+	
+	^ ToolIcons iconNamed: (ToolIcons
+		iconForClass: self selectedClassOrMetaClass
+		selector: aSelector)

packages/Babylonian-Core.package/BlockNode.extension/instance/sizeCodeForEvaluatedValue..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/sizeCodeForEvaluatedValue. (bpCallgraph).st

@@ -0,0 +1,5 @@
+{
+	"class" : {
+		"initialize" : "pre 2/15/2021 10:36" },
+	"instance" : {
+		"messageIconFor:" : "pre 2/15/2021 10:09" } }

packages/Babylonian-Core.package/BlockNode.extension/instance/sizeCodeForValue..st renamed to packages/Babylonian-Core.package/BlockNode.extension/instance/sizeCodeForValue. (bpCallgraph).st

@@ -0,0 +1,14 @@
+{
+	"category" : "Babylonian-UI",
+	"classinstvars" : [
+		 ],
+	"classvars" : [
+		 ],
+	"commentStamp" : "",
+	"instvars" : [
+		 ],
+	"name" : "BPSimpleCallgraphBrowser",
+	"pools" : [
+		 ],
+	"super" : "BPCallgraphBrowser",
+	"type" : "normal" }

packages/Babylonian-Core.package/BlockNode.extension/methodProperties.json

@@ -3,6 +3,7 @@ colorForTraceValue: aBPTraceValue inTrace: aBPTrace
 
 	^ (colorCache at: aBPTrace ifAbsentPut: [| callgraph values path paths uniquePaths colors |
 		callgraph := aBPTrace example currentCallgraph.
+		callgraph ifNil: ["No call graph yet" ^ Color transparent].
 		values := aBPTrace valuesForProbeId: self id.
 		paths := values collect: [:value | | entry |
 			entry := callgraph detect: [:each | 

packages/Babylonian-Core.package/BytecodeEncoder.extension/instance/generateMethodOfClass.trailer.from..st renamed to packages/Babylonian-Core.package/BytecodeEncoder.extension/instance/generateMethodOfClass.trailer.from. (bpCallgraph).st

@@ -3,7 +3,7 @@
 		"isAbstract" : "pre 9/25/2020 10:15" },
 	"instance" : {
 		"callgraphMenu:forTrace:" : "pre 1/15/2021 13:47",
-		"colorForTraceValue:inTrace:" : "pre 1/15/2021 13:46",
+		"colorForTraceValue:inTrace:" : "pre 2/15/2021 10:21",
 		"filterValues:throughSliderForTrace:" : "pre 9/28/2020 11:21",
 		"initialize" : "pre 1/15/2021 13:49",
 		"listenToSlider:" : "jb 12/7/2020 18:59",