*** empty log message ***
authorclaus
Fri, 05 Aug 1994 03:07:58 +0200
changeset 10 676ce0471de4
parent 9 f5b6ab00bdf6
child 11 3553d053d5b8
*** empty log message ***
Change.st
ChangeSet.st
ClassChange.st
ClassChg.st
ClassCommentChange.st
ClassDefinitionChange.st
ClsComChg.st
ClsDefChg.st
MessageTally.st
MessageTracer.st
MethodChange.st
MethodChg.st
MsgTally.st
MsgTracer.st
WMethod.st
WrappedMethod.st
--- a/Change.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/Change.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
 	 category:'System-Changes'
 !
 
+Change comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.5 1994-08-05 01:06:42 claus Exp $
+'!
+
 !Change class methodsFor:'documentation'!
 
 copyright
@@ -35,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.4 1994-06-02 17:19:31 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Change.st,v 1.5 1994-08-05 01:06:42 claus Exp $
 "
 !
 
--- a/ChangeSet.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/ChangeSet.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
 	 category:'System-Changes'
 !
 
+ChangeSet comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.5 1994-08-05 01:06:44 claus Exp $
+'!
+
 !ChangeSet class methodsFor:'documentation'!
 
 copyright
@@ -35,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.4 1994-06-02 17:19:32 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.5 1994-08-05 01:06:44 claus Exp $
 "
 !
 
--- a/ClassChange.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/ClassChange.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
 	 category:'System-Changes'
 !
 
+ClassChange comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.5 1994-08-05 01:06:46 claus Exp $
+'!
+
 !ClassChange class methodsFor:'documentation'!
 
 copyright
@@ -35,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.4 1994-06-02 17:19:34 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/ClassChange.st,v 1.5 1994-08-05 01:06:46 claus Exp $
 "
 !
 
--- a/ClassChg.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/ClassChg.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
 	 category:'System-Changes'
 !
 
+ClassChange comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/Attic/ClassChg.st,v 1.5 1994-08-05 01:06:46 claus Exp $
+'!
+
 !ClassChange class methodsFor:'documentation'!
 
 copyright
@@ -35,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/Attic/ClassChg.st,v 1.4 1994-06-02 17:19:34 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/ClassChg.st,v 1.5 1994-08-05 01:06:46 claus Exp $
 "
 !
 
--- a/ClassCommentChange.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/ClassCommentChange.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
          category:'System-Changes'
 !
 
+ClassCommentChange comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/ClassCommentChange.st,v 1.6 1994-08-05 01:06:47 claus Exp $
+'!
+
 !ClassCommentChange class methodsFor:'documentation'!
 
 copyright
@@ -35,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/ClassCommentChange.st,v 1.5 1994-06-02 17:19:36 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/ClassCommentChange.st,v 1.6 1994-08-05 01:06:47 claus Exp $
 "
 !
 
--- a/ClassDefinitionChange.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/ClassDefinitionChange.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
          category:'System-Changes'
 !
 
+ClassDefinitionChange comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.6 1994-08-05 01:06:49 claus Exp $
+'!
+
 !ClassDefinitionChange class methodsFor:'documentation'!
 
 copyright
@@ -35,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.5 1994-06-02 17:19:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.6 1994-08-05 01:06:49 claus Exp $
 "
 !
 
--- a/ClsComChg.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/ClsComChg.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
          category:'System-Changes'
 !
 
+ClassCommentChange comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/Attic/ClsComChg.st,v 1.6 1994-08-05 01:06:47 claus Exp $
+'!
+
 !ClassCommentChange class methodsFor:'documentation'!
 
 copyright
@@ -35,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/Attic/ClsComChg.st,v 1.5 1994-06-02 17:19:36 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/ClsComChg.st,v 1.6 1994-08-05 01:06:47 claus Exp $
 "
 !
 
--- a/ClsDefChg.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/ClsDefChg.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
          category:'System-Changes'
 !
 
+ClassDefinitionChange comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/Attic/ClsDefChg.st,v 1.6 1994-08-05 01:06:49 claus Exp $
+'!
+
 !ClassDefinitionChange class methodsFor:'documentation'!
 
 copyright
@@ -35,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/Attic/ClsDefChg.st,v 1.5 1994-06-02 17:19:37 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/ClsDefChg.st,v 1.6 1994-08-05 01:06:49 claus Exp $
 "
 !
 
--- a/MessageTally.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/MessageTally.st	Fri Aug 05 03:07:58 1994 +0200
@@ -21,6 +21,8 @@
 MessageTally comment:'
 COPYRIGHT (c) 1989 by Claus Gittinger
               All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.6 1994-08-05 01:07:01 claus Exp $
 '!
 
 !MessageTally class methodsFor:'documentation'!
@@ -41,7 +43,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.5 1994-06-02 17:19:54 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTally.st,v 1.6 1994-08-05 01:07:01 claus Exp $
 "
 !
 
@@ -52,9 +54,9 @@
     To get statistic, use 'MessageTally spyOn:aBlock'.
 
     example:
-	MessageTally spyOn:[
-	    (ByteArray uninitalizedNew:1000) sort
-	]
+        MessageTally spyOn:[
+            (ByteArray uninitalizedNew:1000) sort
+        ]
 "
 ! !
 
@@ -103,11 +105,11 @@
 
     self setupArrays.
     ObjectMemory spyInterruptHandler:self.
-    startTime := OperatingSystem getMillisecondTime.
+    startTime := Time millisecondClockValue.
     OperatingSystem startSpyTimer.
     aBlock value.
     OperatingSystem stopSpyTimer.
-    endTime := OperatingSystem getMillisecondTime.
+    endTime := Time millisecondClockValue.
     ObjectMemory spyInterruptHandler:nil.
     ^ endTime - startTime
 !
--- a/MessageTracer.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/MessageTracer.st	Fri Aug 05 03:07:58 1994 +0200
@@ -20,6 +20,8 @@
 MessageTracer comment:'
 COPYRIGHT (c) 1994 by Claus Gittinger
               All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.3 1994-08-05 01:07:02 claus Exp $
 '!
 
 !MessageTracer class methodsFor:'documentation'!
@@ -40,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.2 1994-06-02 17:19:55 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/MessageTracer.st,v 1.3 1994-08-05 01:07:02 claus Exp $
 "
 !
 
@@ -256,13 +258,13 @@
      ExitBlock will be called, when the method is left, and get context and 
      the methods return value as arguments."
 
-    |parser selector args nArgs class trapMethod s spec lits src idx|
+    |selector class trapMethod s spec lits src idx|
 
     "
      create a new method, which calls the original one,
      but only if not already being trapped.
     "
-    aMethod isWrapped ifTrue:[
+    (aMethod isNil or:[aMethod isWrapped]) ifTrue:[
         ^ aMethod
     ].
 
@@ -393,9 +395,9 @@
 unwrapMethod:aMethod 
     "remove any wrapper on aMethod"
 
-    |parser selector args nArgs class originalMethod s spec lits src idx|
+    |selector class originalMethod idx|
 
-    aMethod isWrapped ifFalse:[
+    (aMethod isNil or:[aMethod isWrapped]) ifFalse:[
         ^ aMethod
     ].
 
@@ -404,7 +406,7 @@
     "
     class := aMethod containingClass.
     class isNil ifTrue:[
-        self error:'cannot place trap (no containing class found)'.
+        'no containing class for method found' printNL.
         ^ aMethod
     ].
     selector := class selectorForMethod:aMethod.
@@ -445,7 +447,7 @@
      ExitBlock will be called, when the method is left, and get context and the methods return value as arguments.
     "
 
-    |parser sourceString selector args nArgs newClass orgClass myMetaclass trapMethod s spec lits src idx|
+    |myMetaclass trapMethod s spec lits idx newClass|
 
     "
      create a new method, which calls the original one,
@@ -467,7 +469,7 @@
     s nextPutAll:'^ retVal'; cr.
 
     trapMethod := Compiler compile:s contents 
-                          forClass:newClass 
+                          forClass:aClass 
                         inCategory:'trapping'
                          notifying:nil
                            install:false
@@ -820,7 +822,8 @@
          onEntry:[:con | 
                      'enter ' errorPrint. methodName errorPrint. 
                      ' receiver=' errorPrint. con receiver printString errorPrint.
-                     ' args=' errorPrint. (con args) printString errorPrintNL.
+                     ' args=' errorPrint. (con args) printString errorPrint.
+                     ' from:' errorPrint. con sender errorPrintNL.
                  ]
          onExit:[:con :retVal |
                      'leave ' errorPrint. methodName errorPrint. 
@@ -919,7 +922,8 @@
                                           '>>' errorPrint.
                                           con selector errorPrint. 
                      ' receiver=' errorPrint. con receiver printString errorPrint.
-                     ' args=' errorPrint. (con args) printString errorPrintNL.
+                     ' args=' errorPrint. (con args) printString errorPrint.
+                     ' from:' errorPrint. con sender errorPrintNL.
                  ]
          onExit:[:con :retVal |
                      'leave ' errorPrint. con receiver class name errorPrint. 
@@ -984,7 +988,8 @@
                                           '>>' errorPrint.
                                           con selector errorPrint. 
                      ' receiver=' errorPrint. con receiver printString errorPrint.
-                     ' args=' errorPrint. (con args) printString errorPrintNL.
+                     ' args=' errorPrint. (con args) printString errorPrint.
+                     ' from:' errorPrint. con sender errorPrintNL.
                  ]
          onExit:[:con :retVal |
                      'leave ' errorPrint. con receiver class name errorPrint. 
--- a/MethodChange.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/MethodChange.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
          category:'System-Changes'
 !
 
+MethodChange comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.5 1994-08-05 01:06:58 claus Exp $
+'!
+
 !MethodChange class methodsFor:'instance creation'!
 
 class:cls selector:sel source:src
--- a/MethodChg.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/MethodChg.st	Fri Aug 05 03:07:58 1994 +0200
@@ -17,6 +17,13 @@
          category:'System-Changes'
 !
 
+MethodChange comment:'
+COPYRIGHT (c) 1993 by Claus Gittinger
+              All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/Attic/MethodChg.st,v 1.5 1994-08-05 01:06:58 claus Exp $
+'!
+
 !MethodChange class methodsFor:'instance creation'!
 
 class:cls selector:sel source:src
--- a/MsgTally.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/MsgTally.st	Fri Aug 05 03:07:58 1994 +0200
@@ -21,6 +21,8 @@
 MessageTally comment:'
 COPYRIGHT (c) 1989 by Claus Gittinger
               All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTally.st,v 1.6 1994-08-05 01:07:01 claus Exp $
 '!
 
 !MessageTally class methodsFor:'documentation'!
@@ -41,7 +43,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/Attic/MsgTally.st,v 1.5 1994-06-02 17:19:54 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTally.st,v 1.6 1994-08-05 01:07:01 claus Exp $
 "
 !
 
@@ -52,9 +54,9 @@
     To get statistic, use 'MessageTally spyOn:aBlock'.
 
     example:
-	MessageTally spyOn:[
-	    (ByteArray uninitalizedNew:1000) sort
-	]
+        MessageTally spyOn:[
+            (ByteArray uninitalizedNew:1000) sort
+        ]
 "
 ! !
 
@@ -103,11 +105,11 @@
 
     self setupArrays.
     ObjectMemory spyInterruptHandler:self.
-    startTime := OperatingSystem getMillisecondTime.
+    startTime := Time millisecondClockValue.
     OperatingSystem startSpyTimer.
     aBlock value.
     OperatingSystem stopSpyTimer.
-    endTime := OperatingSystem getMillisecondTime.
+    endTime := Time millisecondClockValue.
     ObjectMemory spyInterruptHandler:nil.
     ^ endTime - startTime
 !
--- a/MsgTracer.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/MsgTracer.st	Fri Aug 05 03:07:58 1994 +0200
@@ -20,6 +20,8 @@
 MessageTracer comment:'
 COPYRIGHT (c) 1994 by Claus Gittinger
               All Rights Reserved
+
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.3 1994-08-05 01:07:02 claus Exp $
 '!
 
 !MessageTracer class methodsFor:'documentation'!
@@ -40,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.2 1994-06-02 17:19:55 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/MsgTracer.st,v 1.3 1994-08-05 01:07:02 claus Exp $
 "
 !
 
@@ -256,13 +258,13 @@
      ExitBlock will be called, when the method is left, and get context and 
      the methods return value as arguments."
 
-    |parser selector args nArgs class trapMethod s spec lits src idx|
+    |selector class trapMethod s spec lits src idx|
 
     "
      create a new method, which calls the original one,
      but only if not already being trapped.
     "
-    aMethod isWrapped ifTrue:[
+    (aMethod isNil or:[aMethod isWrapped]) ifTrue:[
         ^ aMethod
     ].
 
@@ -393,9 +395,9 @@
 unwrapMethod:aMethod 
     "remove any wrapper on aMethod"
 
-    |parser selector args nArgs class originalMethod s spec lits src idx|
+    |selector class originalMethod idx|
 
-    aMethod isWrapped ifFalse:[
+    (aMethod isNil or:[aMethod isWrapped]) ifFalse:[
         ^ aMethod
     ].
 
@@ -404,7 +406,7 @@
     "
     class := aMethod containingClass.
     class isNil ifTrue:[
-        self error:'cannot place trap (no containing class found)'.
+        'no containing class for method found' printNL.
         ^ aMethod
     ].
     selector := class selectorForMethod:aMethod.
@@ -445,7 +447,7 @@
      ExitBlock will be called, when the method is left, and get context and the methods return value as arguments.
     "
 
-    |parser sourceString selector args nArgs newClass orgClass myMetaclass trapMethod s spec lits src idx|
+    |myMetaclass trapMethod s spec lits idx newClass|
 
     "
      create a new method, which calls the original one,
@@ -467,7 +469,7 @@
     s nextPutAll:'^ retVal'; cr.
 
     trapMethod := Compiler compile:s contents 
-                          forClass:newClass 
+                          forClass:aClass 
                         inCategory:'trapping'
                          notifying:nil
                            install:false
@@ -820,7 +822,8 @@
          onEntry:[:con | 
                      'enter ' errorPrint. methodName errorPrint. 
                      ' receiver=' errorPrint. con receiver printString errorPrint.
-                     ' args=' errorPrint. (con args) printString errorPrintNL.
+                     ' args=' errorPrint. (con args) printString errorPrint.
+                     ' from:' errorPrint. con sender errorPrintNL.
                  ]
          onExit:[:con :retVal |
                      'leave ' errorPrint. methodName errorPrint. 
@@ -919,7 +922,8 @@
                                           '>>' errorPrint.
                                           con selector errorPrint. 
                      ' receiver=' errorPrint. con receiver printString errorPrint.
-                     ' args=' errorPrint. (con args) printString errorPrintNL.
+                     ' args=' errorPrint. (con args) printString errorPrint.
+                     ' from:' errorPrint. con sender errorPrintNL.
                  ]
          onExit:[:con :retVal |
                      'leave ' errorPrint. con receiver class name errorPrint. 
@@ -984,7 +988,8 @@
                                           '>>' errorPrint.
                                           con selector errorPrint. 
                      ' receiver=' errorPrint. con receiver printString errorPrint.
-                     ' args=' errorPrint. (con args) printString errorPrintNL.
+                     ' args=' errorPrint. (con args) printString errorPrint.
+                     ' from:' errorPrint. con sender errorPrintNL.
                  ]
          onExit:[:con :retVal |
                      'leave ' errorPrint. con receiver class name errorPrint. 
--- a/WMethod.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/WMethod.st	Fri Aug 05 03:07:58 1994 +0200
@@ -21,6 +21,7 @@
 COPYRIGHT (c) 1994 by Claus Gittinger
               All Rights Reserved
 
+$Header: /cvs/stx/stx/libbasic3/Attic/WMethod.st,v 1.3 1994-08-05 01:07:58 claus Exp $
 '!
 
 !WrappedMethod class methodsFor:'documentation'!
@@ -41,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/Attic/WMethod.st,v 1.2 1994-06-02 17:20:20 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/Attic/WMethod.st,v 1.3 1994-08-05 01:07:58 claus Exp $
 "
 !
 
@@ -78,11 +79,7 @@
 !
 
 methodArgAndVarNames
-    |names|
-
-    names := self methodArgNames.
-    names isNil ifTrue:[^ #()].
-    ^ names
+    ^ self originalMethod methodArgAndVarNames
 !
 
 source
@@ -98,10 +95,10 @@
 !
 
 numberOfMethodVars
-    ^ 0
+    ^ self originalMethod numberOfMethodVars 
 !
 
 methodVarNames
-    ^ nil
+    ^ self originalMethod methodVarNames 
 ! !
 
--- a/WrappedMethod.st	Thu Jun 02 19:20:20 1994 +0200
+++ b/WrappedMethod.st	Fri Aug 05 03:07:58 1994 +0200
@@ -21,6 +21,7 @@
 COPYRIGHT (c) 1994 by Claus Gittinger
               All Rights Reserved
 
+$Header: /cvs/stx/stx/libbasic3/WrappedMethod.st,v 1.3 1994-08-05 01:07:58 claus Exp $
 '!
 
 !WrappedMethod class methodsFor:'documentation'!
@@ -41,7 +42,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/WrappedMethod.st,v 1.2 1994-06-02 17:20:20 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/WrappedMethod.st,v 1.3 1994-08-05 01:07:58 claus Exp $
 "
 !
 
@@ -78,11 +79,7 @@
 !
 
 methodArgAndVarNames
-    |names|
-
-    names := self methodArgNames.
-    names isNil ifTrue:[^ #()].
-    ^ names
+    ^ self originalMethod methodArgAndVarNames
 !
 
 source
@@ -98,10 +95,10 @@
 !
 
 numberOfMethodVars
-    ^ 0
+    ^ self originalMethod numberOfMethodVars 
 !
 
 methodVarNames
-    ^ nil
+    ^ self originalMethod methodVarNames 
 ! !