Mercurial Mercurial > hg > stx-libbasic3 / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
MessageTracer.st
changeset 503 67f6584e0f9f
parent 501 c3ccbea7930c
child 506 02c057d1ce1a 
--- a/MessageTracer.st	Thu Oct 17 14:00:28 1996 +0200
+++ b/MessageTracer.st	Tue Oct 22 19:57:06 1996 +0200
@@ -13,13 +13,13 @@
 Object subclass:#MessageTracer
 	instanceVariableNames:'traceDetail'
 	classVariableNames:'BreakpointSignal CallingLevel BreakBlock TraceSenderBlock
-		LeaveBlock MethodCounts MethodMemoryUsage MethodTiming
-		TraceFullBlock'
+		LeaveBreakBlock LeaveTraceBlock MethodCounts MethodMemoryUsage
+		MethodTiming TraceFullBlock'
 	poolDictionaries:''
 	category:'System-Debugging-Support'
 !
 
-!MessageTracer  class methodsFor:'documentation'!
+!MessageTracer class methodsFor:'documentation'!
 
 copyright
 "
@@ -191,18 +191,19 @@
 "
 ! !
 
-!MessageTracer  class methodsFor:'initialization'!
+!MessageTracer class methodsFor:'initialization'!
 
 initialize
     BreakpointSignal isNil ifTrue:[
-	BreakpointSignal := HaltSignal newSignalMayProceed:true.
-	BreakpointSignal nameClass:self message:#breakpointSignal.
-	BreakpointSignal notifierString:'breakpoint encountered'.
+        BreakpointSignal := HaltSignal newSignalMayProceed:true.
+        BreakpointSignal nameClass:self message:#breakpointSignal.
+        BreakpointSignal notifierString:'breakpoint encountered'.
 
-	BreakBlock       := [:con | BreakpointSignal raiseIn:con].
-	TraceSenderBlock := [:con | MessageTracer printEntrySender:con].
-	TraceFullBlock   := [:con | con fullPrintAll].
-	LeaveBlock       := [:con :retVal | ].
+        BreakBlock       := [:con | BreakpointSignal raiseIn:con].
+        TraceSenderBlock := [:con | MessageTracer printEntrySender:con].
+        TraceFullBlock   := [:con | con fullPrintAll].
+        LeaveBreakBlock  := [:con :retVal | ].
+        LeaveTraceBlock  := [:con :retVal | ].
     ]
 
     "
@@ -210,16 +211,16 @@
      MessageTracer initialize
     "
 
-    "Modified: 15.12.1995 / 18:19:13 / cg"
+    "Modified: 22.10.1996 / 17:39:14 / cg"
 ! !
 
-!MessageTracer  class methodsFor:'Signal constants'!
+!MessageTracer class methodsFor:'Signal constants'!
 
 breakpointSignal
     ^ BreakpointSignal
 ! !
 
-!MessageTracer  class methodsFor:'class tracing'!
+!MessageTracer class methodsFor:'class tracing'!
 
 traceClass:aClass selector:aSelector
     "arrange for a trace message to be output on Stderr, when a message with aSelector is
@@ -263,7 +264,7 @@
     ^ self untrapClass:aClass
 ! !
 
-!MessageTracer  class methodsFor:'class wrapping'!
+!MessageTracer class methodsFor:'class wrapping'!
 
 wrapClass:orgClass selector:aSelector onEntry:entryBlock onExit:exitBlock 
     "arrange for the two blocks entryBlock and exitBlock to be evaluated whenever
@@ -427,7 +428,7 @@
     "Modified: 10.9.1996 / 20:07:01 / cg"
 ! !
 
-!MessageTracer  class methodsFor:'cleanup'!
+!MessageTracer class methodsFor:'cleanup'!
 
 cleanup
     "if you forgot which classes/methods where wrapped and/or trapped,
@@ -441,7 +442,7 @@
     "
 ! !
 
-!MessageTracer  class methodsFor:'execution trace '!
+!MessageTracer class methodsFor:'execution trace '!
 
 debugTrace:aBlock
     "trace execution of aBlock. This is for system debugging only"
@@ -481,7 +482,7 @@
     "
 ! !
 
-!MessageTracer  class methodsFor:'method breakpointing'!
+!MessageTracer class methodsFor:'method breakpointing'!
 
 trapClass:aClass selector:aSelector
     "arrange for the debugger to be entered when a message with aSelector is 
@@ -512,7 +513,7 @@
 
     ^ self wrapMethod:aMethod
               onEntry:BreakBlock
-               onExit:LeaveBlock.
+               onExit:LeaveBreakBlock.
 
     "
      MessageTracer trapMethod:(Collection compiledMethodAt:#select:).
@@ -522,7 +523,7 @@
      MessageTracer unwrapMethod:(Collection compiledMethodAt:#select:).
     "
 
-    "Modified: 14.10.1996 / 15:10:27 / cg"
+    "Modified: 22.10.1996 / 17:39:58 / cg"
 !
 
 trapMethod:aMethod forInstancesOf:aClass
@@ -534,16 +535,18 @@
      entry/leave blocks."
 
     ^ self wrapMethod:aMethod
-	      onEntry:[:context |
-			 (context receiver isMemberOf:aClass) ifTrue:[
-			     BreakpointSignal raiseIn:context
-			 ]
-		      ]
-	       onExit:LeaveBlock.
+              onEntry:[:context |
+                         (context receiver isMemberOf:aClass) ifTrue:[
+                             BreakpointSignal raiseIn:context
+                         ]
+                      ]
+               onExit:LeaveBreakBlock.
 
     "
      MessageTracer trapMethod:(View compiledMethodAt:#redraw) forInstancesOf:myView.
     "
+
+    "Modified: 22.10.1996 / 17:40:03 / cg"
 !
 
 trapMethod:aMethod inProcess:aProcess
@@ -562,9 +565,10 @@
                                 BreakpointSignal raiseIn:con
                               ]  
                       ]
-               onExit:LeaveBlock.
+               onExit:LeaveBreakBlock.
 
     "Created: 14.10.1996 / 15:38:46 / cg"
+    "Modified: 22.10.1996 / 17:40:06 / cg"
 !
 
 untrapAllClasses
@@ -656,7 +660,7 @@
     ^ self unwrapMethod:aMethod
 ! !
 
-!MessageTracer  class methodsFor:'method counting'!
+!MessageTracer class methodsFor:'method counting'!
 
 countMethod:aMethod
     "arrange for a aMethods execution to be counted.
@@ -726,7 +730,7 @@
     "Modified: 15.12.1995 / 15:43:53 / cg"
 ! !
 
-!MessageTracer  class methodsFor:'method memory usage'!
+!MessageTracer class methodsFor:'method memory usage'!
 
 countMemoryUsageOfMethod:aMethod
     "arrange for aMethods memory usage to be counted.
@@ -827,7 +831,7 @@
     "Modified: 18.12.1995 / 21:54:36 / stefan"
 ! !
 
-!MessageTracer  class methodsFor:'method timing'!
+!MessageTracer class methodsFor:'method timing'!
 
 executionTimesOfMethod:aMethod
     "return the current times"
@@ -936,7 +940,7 @@
     "Modified: 17.6.1996 / 17:10:43 / cg"
 ! !
 
-!MessageTracer  class methodsFor:'method tracing'!
+!MessageTracer class methodsFor:'method tracing'!
 
 traceMethod:aMethod
     "arrange for a trace message to be output on Stderr, when aMethod is executed.
@@ -1010,10 +1014,11 @@
      Use untraceMethod to remove this trace."
 
     ^ self wrapMethod:aMethod
-	      onEntry:TraceFullBlock 
-	      onExit:LeaveBlock.
+              onEntry:TraceFullBlock 
+              onExit:LeaveTraceBlock.
 
     "Created: 15.12.1995 / 18:19:31 / cg"
+    "Modified: 22.10.1996 / 17:39:28 / cg"
 !
 
 traceMethodSender:aMethod
@@ -1022,8 +1027,10 @@
      Use untraceMethod to remove this trace."
 
     ^ self wrapMethod:aMethod
-	      onEntry:TraceSenderBlock 
-	      onExit:LeaveBlock.
+              onEntry:TraceSenderBlock 
+              onExit:LeaveTraceBlock.
+
+    "Modified: 22.10.1996 / 17:39:33 / cg"
 !
 
 untraceMethod:aMethod
@@ -1035,7 +1042,7 @@
     ^ self unwrapMethod:aMethod
 ! !
 
-!MessageTracer  class methodsFor:'method wrapping'!
+!MessageTracer class methodsFor:'method wrapping'!
 
 unwrapAllMethods
     "just in case you dont know what methods have break/trace-points
@@ -1297,7 +1304,7 @@
     "Modified: 25.6.1996 / 22:04:51 / stefan"
 ! !
 
-!MessageTracer  class methodsFor:'object breakpointing'!
+!MessageTracer class methodsFor:'object breakpointing'!
 
 trap:anObject selector:aSelector
     "arrange for the debugger to be entered when a message with aSelector is 
@@ -1305,9 +1312,9 @@
      The current implementation does not allow integers or nil to be trapped."
 
     self wrap:anObject
-	 selector:aSelector
-	 onEntry:BreakBlock
-	 onExit:LeaveBlock.
+         selector:aSelector
+         onEntry:BreakBlock
+         onExit:LeaveBreakBlock.
 
     "
      |p|
@@ -1316,21 +1323,27 @@
      MessageTracer trap:p selector:#x:.
      p x:5
     "
+
+    "Modified: 22.10.1996 / 17:39:41 / cg"
 !
 
 trap:anObject selectors:aCollection
     self wrap:anObject
-	 selectors:aCollection
-	 onEntry:BreakBlock
-	 onExit:LeaveBlock.
+         selectors:aCollection
+         onEntry:BreakBlock
+         onExit:LeaveBreakBlock.
+
+    "Modified: 22.10.1996 / 17:39:50 / cg"
 !
 
 trapAll:anObject
     "trap on all messages which are understood by anObject"
 
     self wrapAll:anObject
-	 onEntry:BreakBlock
-	 onExit:LeaveBlock.
+         onEntry:BreakBlock
+         onExit:LeaveBreakBlock.
+
+    "Modified: 22.10.1996 / 17:39:54 / cg"
 !
 
 trapAll:anObject from:aClass
@@ -1414,7 +1427,7 @@
     "Modified: 10.9.1996 / 20:06:14 / cg"
 ! !
 
-!MessageTracer  class methodsFor:'object tracing'!
+!MessageTracer class methodsFor:'object tracing'!
 
 trace:anObject selector:aSelector
     "arrange for a trace message to be output on Stderr, when a message with 
@@ -1528,13 +1541,13 @@
 
     methodName := anObject class name , '>>' , aSelector.
     self wrap:anObject
-	 selector:aSelector 
-	 onEntry:[:con | 
-		     methodName errorPrint. 
-		     ' from ' errorPrint. 
-		     con sender errorPrintNL.
-		 ]
-	 onExit:LeaveBlock.
+         selector:aSelector 
+         onEntry:[:con | 
+                     methodName errorPrint. 
+                     ' from ' errorPrint. 
+                     con sender errorPrintNL.
+                 ]
+         onExit:LeaveTraceBlock.
 
     "
      |p|
@@ -1555,6 +1568,8 @@
      MessageTracer traceSender:a selector:#at:.
      a sort.
     "
+
+    "Modified: 22.10.1996 / 17:39:36 / cg"
 !
 
 untrace:anObject
@@ -1575,7 +1590,7 @@
     ^ self untrap:anObject selector:aSelector
 ! !
 
-!MessageTracer  class methodsFor:'object wrapping'!
+!MessageTracer class methodsFor:'object wrapping'!
 
 wrap:anObject selector:aSelector onEntry:entryBlock onExit:exitBlock
     "arrange for the two blocks entryBlock and exitBlock to be evaluated whenever
@@ -1782,7 +1797,27 @@
     "Modified: 5.6.1996 / 14:50:07 / stefan"
 ! !
 
-!MessageTracer  class methodsFor:'trace helpers'!
+!MessageTracer class methodsFor:'queries'!
+
+isTrapped:aMethod
+    "return true, if a breakpoint is set on aMethod.
+     This only returns true for standard breakpoints (i.e. for user-wraps,
+     this returns false)"
+
+    aMethod isWrapped ifFalse:[^ false].
+    ^ aMethod basicLiterals includesIdentical:LeaveBreakBlock
+
+    "
+     MessageTracer trapMethod:(Collection compiledMethodAt:#select:).
+     Transcript showCR:(Collection compiledMethodAt:#select:) isWrapped.
+     Transcript showCR:(MessageTracer isTrapped:(Collection compiledMethodAt:#select:)).
+     MessageTracer unwrapMethod:(Collection compiledMethodAt:#select:).
+    "
+
+    "Modified: 22.10.1996 / 17:40:37 / cg"
+! !
+
+!MessageTracer class methodsFor:'trace helpers'!
 
 printEntryFull:aContext
     self printEntryFull:aContext level:0
@@ -1868,9 +1903,9 @@
     "
 ! !
 
-!MessageTracer  class methodsFor:'documentation'!
+!MessageTracer class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.46 1996-10-15 20:46:11 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.47 1996-10-22 17:57:06 cg Exp $'
 ! !
 MessageTracer initialize!
hg/stx-libbasic3