8 be provided or otherwise made available to, or used by, any |
8 be provided or otherwise made available to, or used by, any |
9 other person. No title to or ownership of the software is |
9 other person. No title to or ownership of the software is |
10 hereby transferred. |
10 hereby transferred. |
11 " |
11 " |
12 |
12 |
|
13 'From Smalltalk/X, Version:2.10.8 on 18-dec-1995 at 22:59:12' ! |
|
14 |
13 Object subclass:#MessageTracer |
15 Object subclass:#MessageTracer |
14 instanceVariableNames:'traceDetail' |
16 instanceVariableNames:'traceDetail' |
15 classVariableNames:'BreakpointSignal CallingLevel BreakBlock TraceSenderBlock |
17 classVariableNames:'BreakpointSignal CallingLevel BreakBlock TraceSenderBlock |
16 LeaveBlock MethodCounts TraceFullBlock' |
18 LeaveBlock MethodCounts MethodMemoryUsage TraceFullBlock' |
17 poolDictionaries:'' |
19 poolDictionaries:'' |
18 category:'System-Debugging-Support' |
20 category:'System-Debugging-Support' |
19 ! |
21 ! |
20 |
22 |
21 !MessageTracer class methodsFor:'documentation'! |
23 !MessageTracer class methodsFor:'documentation'! |
672 "remove counting of aMethod" |
674 "remove counting of aMethod" |
673 |
675 |
674 ^ self unwrapMethod:aMethod |
676 ^ self unwrapMethod:aMethod |
675 |
677 |
676 "Modified: 15.12.1995 / 15:43:53 / cg" |
678 "Modified: 15.12.1995 / 15:43:53 / cg" |
|
679 ! ! |
|
680 |
|
681 !MessageTracer class methodsFor:'method memory usage'! |
|
682 |
|
683 countMemoryUsageOfMethod:aMethod |
|
684 "arrange for aMethods memory usage to be counted. |
|
685 Use unwrapMethod to remove this." |
|
686 |
|
687 |lvl inside oldPriority oldScavengeCount oldNewUsed| |
|
688 |
|
689 MethodCounts isNil ifTrue:[ |
|
690 MethodCounts := IdentityDictionary new. |
|
691 ]. |
|
692 MethodMemoryUsage isNil ifTrue:[ |
|
693 MethodMemoryUsage := IdentityDictionary new. |
|
694 ]. |
|
695 |
|
696 MethodCounts at:aMethod put:0. |
|
697 MethodMemoryUsage at:aMethod put:0. |
|
698 |
|
699 ^ self wrapMethod:aMethod |
|
700 onEntry:[:con | |
|
701 oldPriority := Processor activeProcess changePriority:(Processor userInterruptPriority). |
|
702 oldNewUsed := ObjectMemory newSpaceUsed. |
|
703 oldScavengeCount := ObjectMemory scavengeCount. |
|
704 ] |
|
705 onExit:[:con :retVal | |
|
706 |cnt memUse scavenges| |
|
707 |
|
708 memUse := ObjectMemory newSpaceUsed - oldNewUsed. |
|
709 scavenges := ObjectMemory scavengeCount - oldScavengeCount. |
|
710 scavenges ~= 0 ifTrue:[ |
|
711 memUse := memUse + (ObjectMemory newSpaceSize * scavenges) |
|
712 ]. |
|
713 |
|
714 cnt := MethodCounts at:aMethod ifAbsent:0. |
|
715 MethodCounts at:aMethod put:(cnt + 1). |
|
716 cnt := MethodMemoryUsage at:aMethod ifAbsent:0. |
|
717 MethodMemoryUsage at:aMethod put:(cnt + memUse). |
|
718 Processor activeProcess priority:oldPriority |
|
719 ] |
|
720 onUnwind:[ |
|
721 oldPriority notNil ifTrue:[ |
|
722 Processor activeProcess priority:oldPriority |
|
723 ] |
|
724 ] |
|
725 |
|
726 " |
|
727 MessageTracer countMemoryUsageOfMethod:(Integer compiledMethodAt:#factorial). |
|
728 3 factorial. |
|
729 (MessageTracer memoryUsageOfMethod:(Integer compiledMethodAt:#factorial)) printNL. |
|
730 MessageTracer stopCountingMemoryUsageOfMethod:(Integer compiledMethodAt:#factorial) |
|
731 " |
|
732 |
|
733 "Created: 18.12.1995 / 15:41:27 / stefan" |
|
734 "Modified: 18.12.1995 / 21:46:48 / stefan" |
|
735 ! |
|
736 |
|
737 isCountingMemoryUsage:aMethod |
|
738 "return true if aMethod is counting memoryUsage" |
|
739 |
|
740 MethodMemoryUsage isNil ifTrue:[^ false]. |
|
741 (MethodMemoryUsage includesKey:aMethod) ifTrue:[^ true]. |
|
742 aMethod isWrapped ifTrue:[ |
|
743 ^ MethodMemoryUsage includesKey:aMethod originalMethod |
|
744 ]. |
|
745 ^ false |
|
746 |
|
747 "Created: 18.12.1995 / 15:51:49 / stefan" |
|
748 ! |
|
749 |
|
750 memoryUsageOfMethod:aMethod |
|
751 "return the current count" |
|
752 |
|
753 |count memUse| |
|
754 |
|
755 (MethodCounts isNil or:[MethodMemoryUsage isNil]) ifTrue:[^ 0]. |
|
756 aMethod isWrapped ifTrue:[ |
|
757 count := MethodCounts at:aMethod originalMethod ifAbsent:nil. |
|
758 memUse := MethodMemoryUsage at:aMethod originalMethod ifAbsent:nil. |
|
759 ]. |
|
760 memUse isNil ifTrue:[ |
|
761 count := MethodCounts at:aMethod ifAbsent:0. |
|
762 memUse := MethodMemoryUsage at:aMethod ifAbsent:0. |
|
763 ]. |
|
764 count = 0 ifTrue:[^ 0]. |
|
765 ^ memUse//count |
|
766 |
|
767 "Modified: 18.12.1995 / 16:25:51 / stefan" |
|
768 ! |
|
769 |
|
770 stopCountingMemoryUsageOfMethod:aMethod |
|
771 "remove counting memory of aMethod" |
|
772 |
|
773 ^ self unwrapMethod:aMethod |
|
774 |
|
775 "Modified: 18.12.1995 / 21:54:36 / stefan" |
677 ! ! |
776 ! ! |
678 |
777 |
679 !MessageTracer class methodsFor:'method tracing'! |
778 !MessageTracer class methodsFor:'method tracing'! |
680 |
779 |
681 traceMethod:aMethod |
780 traceMethod:aMethod |
833 ^ originalMethod |
932 ^ originalMethod |
834 |
933 |
835 "Modified: 17.12.1995 / 16:00:55 / cg" |
934 "Modified: 17.12.1995 / 16:00:55 / cg" |
836 ! |
935 ! |
837 |
936 |
838 wrapMethod:aMethod onEntry:entryBlock onExit:exitBlock |
937 wrapMethod:aMethod onEntry:entryBlock onExit:exitBlock |
|
938 ^ self wrapMethod:aMethod onEntry:entryBlock onExit:exitBlock onUnwind:nil |
|
939 |
|
940 "Modified: 18.12.1995 / 15:58:12 / stefan" |
|
941 ! |
|
942 |
|
943 wrapMethod:aMethod onEntry:entryBlock onExit:exitBlock onUnwind:unwindBlock |
839 "arrange for the two blocks entryBlock and exitBlock to be evaluated whenever |
944 "arrange for the two blocks entryBlock and exitBlock to be evaluated whenever |
840 aMethod is evaluated. |
945 aMethod is evaluated. |
841 EntryBlock will be called on entry, and gets the current context passed as argument. |
946 EntryBlock will be called on entry, and gets the current context passed as argument. |
842 ExitBlock will be called, when the method is left, and gets the context and |
947 ExitBlock will be called, when the method is left, and gets the context and |
843 the methods return value as arguments." |
948 the methods return value as arguments. |
|
949 UnwindBlock will be called when the contxt of aMethod is unwound. |
|
950 If there is an unwindBlock, the entry and exitBlocks will be called within the unwind block, |
|
951 beacause allocating the unwindBlock uses memory and some users want to count allocated memory. |
|
952 " |
844 |
953 |
845 |selector class trapMethod s spec lits src idx save| |
954 |selector class trapMethod s spec lits src idx save| |
846 |
955 |
847 CallingLevel := 0. |
956 CallingLevel := 0. |
848 |
957 |
878 " |
987 " |
879 create a method, executing the trap-blocks and the original method via a direct call |
988 create a method, executing the trap-blocks and the original method via a direct call |
880 " |
989 " |
881 s := WriteStream on:String new. |
990 s := WriteStream on:String new. |
882 s nextPutAll:spec. |
991 s nextPutAll:spec. |
883 s nextPutAll:' |retVal| '. |
992 s nextPutAll:' |retVal context| '. |
|
993 s nextPutAll:' context := thisContext.'. |
|
994 unwindBlock notNil ifTrue:[ |
|
995 s nextPutAll:'['. |
|
996 ]. |
884 entryBlock notNil ifTrue:[ |
997 entryBlock notNil ifTrue:[ |
885 s nextPutAll:'#entryBlock yourself value:thisContext. '. |
998 s nextPutAll:'#entryBlock yourself value:context. '. |
886 ]. |
999 ]. |
887 s nextPutAll:'retVal := #originalMethod yourself'; |
1000 s nextPutAll:'retVal := #originalMethod yourself'; |
888 nextPutAll: ' valueWithReceiver:(thisContext receiver)'; |
1001 nextPutAll: ' valueWithReceiver:(context receiver)'; |
889 nextPutAll: ' arguments:(thisContext args)'; |
1002 nextPutAll: ' arguments:(context args)'; |
890 nextPutAll: ' selector:(thisContext selector)'; |
1003 nextPutAll: ' selector:(context selector)'; |
891 nextPutAll: ' search:(thisContext searchClass)'; |
1004 nextPutAll: ' search:(context searchClass)'; |
892 nextPutAll: ' sender:nil. '. |
1005 nextPutAll: ' sender:nil. '. |
893 |
1006 |
894 exitBlock notNil ifTrue:[ |
1007 exitBlock notNil ifTrue:[ |
895 s nextPutAll:'#exitBlock yourself value:thisContext value:retVal.'. |
1008 s nextPutAll:'#exitBlock yourself value:context value:retVal.'. |
|
1009 ]. |
|
1010 unwindBlock notNil ifTrue:[ |
|
1011 s nextPutAll:'] valueOnUnwindDo:#unwindBlock yourself.'. |
896 ]. |
1012 ]. |
897 s nextPutAll:'^ retVal'; cr. |
1013 s nextPutAll:'^ retVal'; cr. |
898 |
1014 |
899 src := s contents. |
1015 src := s contents. |
900 save := Compiler stcCompilation. |
1016 save := Compiler stcCompilation. |
923 lits at:(lits indexOf:#entryBlock) put:entryBlock. |
1039 lits at:(lits indexOf:#entryBlock) put:entryBlock. |
924 ]. |
1040 ]. |
925 lits at:(lits indexOf:#originalMethod) put:aMethod. |
1041 lits at:(lits indexOf:#originalMethod) put:aMethod. |
926 exitBlock notNil ifTrue:[ |
1042 exitBlock notNil ifTrue:[ |
927 lits at:(lits indexOf:#exitBlock) put:exitBlock. |
1043 lits at:(lits indexOf:#exitBlock) put:exitBlock. |
|
1044 ]. |
|
1045 unwindBlock notNil ifTrue:[ |
|
1046 lits at:(lits indexOf:#unwindBlock) put:unwindBlock. |
928 ]. |
1047 ]. |
929 " |
1048 " |
930 change the source of this new method |
1049 change the source of this new method |
931 (to avoid confusion in the debugger ...) |
1050 (to avoid confusion in the debugger ...) |
932 " |
1051 " |