Dev/Mod/Profiler.odc

MODULE DevProfiler;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		WinApi, WinMM,
		Kernel, Dialog, Fonts, Ports, Views,
		TextModels, TextRulers, TextViews, TextControllers, TextMappers, StdLog;
	
	CONST
		maxMod = 256;
		
	TYPE
		Module = RECORD
			start, end: INTEGER;	(* address range *)
			first, last: INTEGER;	(* procedures *)
			mod: Kernel.Module;
			count: INTEGER;
		END;
		
		Proc = POINTER TO RECORD
			name: Kernel.Name;
			p: INTEGER;
			next: Proc
		END;
		
	VAR
		mod: ARRAY maxMod OF Module;
		pEnd, pCount: POINTER TO ARRAY OF INTEGER;
		numMod, numProc, listLen: INTEGER;
		otherCount, totalCount: INTEGER;
		out: TextMappers.Formatter;
		started: BOOLEAN;
		
	(* ------------- non-portable part ------------ *)
	
	VAR id, periode: INTEGER;
	
	PROCEDURE^ Count (pc: INTEGER);
	
	PROCEDURE Recorder (id, msg, user, dw1, dw2: INTEGER);
		VAR res: INTEGER; context: WinApi.CONTEXT;
	BEGIN
		context.ContextFlags := WinApi.CONTEXT_CONTROL;
		res := WinApi.GetThreadContext(user, context);
		Count(context.Eip)	(* current pc of main thread *)
	END Recorder;
	
	PROCEDURE StartRecording;
		(* Start calling Count periodically by an interrupt handler *)
		VAR res: INTEGER; main: WinApi.HANDLE; tc: WinMM.TIMECAPS;
	BEGIN
		res := WinApi.DuplicateHandle(WinApi.GetCurrentProcess(), WinApi.GetCurrentThread(),
					WinApi.GetCurrentProcess(), main, {1, 3, 4, 16..19}, 0, {});
		res := WinMM.timeGetDevCaps(tc, SIZE(WinMM.TIMECAPS));
		periode := tc.wPeriodMin * 3;
		res := WinMM.timeBeginPeriod(periode);
		id := WinMM.timeSetEvent(periode, 0, Recorder, main, WinMM.TIME_PERIODIC);
		ASSERT(id # 0, 100)
	END StartRecording;
	
	PROCEDURE StopRecording;
		(* stop calling Count *)
		VAR res: INTEGER;
	BEGIN
		res := WinMM.timeKillEvent(id);
		res := WinMM.timeEndPeriod(periode)
	END StopRecording;
	
	PROCEDURE Init;
	BEGIN
	END Init;
	
	(* ------------- portable part ------------- *)

	PROCEDURE Count (pc: INTEGER);
		VAR l, r, m: INTEGER;
	BEGIN
		l := 0; r := numMod;
		WHILE l < r DO	(* binary search on modules *)
			m := (l + r) DIV 2;
			IF pc >= mod[m].end THEN l := m + 1 ELSE r := m END
		END;
		IF (r < numMod) & (pc >= mod[r].start) & (pc < mod[r].end) THEN
			INC(mod[r].count); INC(totalCount);
			l := mod[r].first; r := mod[r].last + 1;
			WHILE l < r DO	(* binary search on procedures *)
				m := (l + r) DIV 2;
				IF pc >= pEnd[m] THEN l := m + 1 ELSE r := m END
			END;
			INC(pCount[r])
		ELSE INC(otherCount)
		END
	END Count;
	
	
	(* ---------- programming interface ---------- *)
	
	PROCEDURE InsertModule (m: Kernel.Module; VAR done: BOOLEAN);
		VAR i: INTEGER;
	BEGIN
		IF (m # NIL) & (numMod < maxMod) THEN
			i := numMod; INC(numMod);
			WHILE (i > 0) & (m.code < mod[i-1].mod.code) DO mod[i] := mod[i-1]; DEC(i) END;
			mod[i].mod := m;
			done := TRUE
		ELSE
			done := FALSE
		END
	END InsertModule;
	
	PROCEDURE Start*;
		VAR ref, end, i, j: INTEGER; n: Kernel.Name; m: Kernel.Module; ok: BOOLEAN;
	BEGIN
		IF ~started THEN
			IF listLen = 0 THEN	(* all modules *)
				m := Kernel.modList;
				WHILE m # NIL DO
					IF m.refcnt >= 0 THEN InsertModule(m, ok) END;
					m := m.next
				END
			END;
			otherCount := 0; totalCount := 0; numProc := 0; i := 0;
			WHILE i < numMod DO
				m := mod[i].mod;
				mod[i].start := m.code;
				mod[i].first := numProc;
				ref := m.refs;
				Kernel.GetRefProc(ref, end, n);
				WHILE end # 0 DO INC(numProc); Kernel.GetRefProc(ref, end, n) END;
				mod[i].last := numProc - 1;
				INC(i)
			END;
			NEW(pEnd, numProc);
			NEW(pCount, numProc);
			i := 0; j := 0;
			WHILE i < numMod DO
				m := mod[i].mod; ref := m.refs;
				Kernel.GetRefProc(ref, end, n);
				WHILE end # 0 DO
					pEnd[j] := m.code + end; pCount[j] := 0; INC(j);
					Kernel.GetRefProc(ref, end, n)
				END;
				mod[i].end := pEnd[mod[i].last];
				mod[i].count := 0;
				INC(i)
			END;
			IF numMod > 0 THEN StartRecording END;
			started := TRUE
		END
	END Start;
	
	PROCEDURE Stop*;
	BEGIN
		IF started THEN
			StopRecording;
			started := FALSE
		END
	END Stop;
	
	PROCEDURE Reset*;
	BEGIN
		Stop;
		numMod := 0; numProc := 0; listLen := 0;
		pEnd := NIL; pCount := NIL
	END Reset;
	
	PROCEDURE SetModuleList* (list: ARRAY OF CHAR);
		VAR i, j: INTEGER; name: ARRAY 256 OF CHAR; ch: CHAR; done: BOOLEAN;
	BEGIN
		Stop;
		Reset;
		i := 0;
		ch := list[i];
		WHILE (i < LEN(list)) & (ch # 0X) DO
			WHILE (ch # 0X) & (ch < "0") OR (ch > "9") & (CAP(ch) < "A") OR (CAP(ch) > "Z") DO INC(i); ch := list[i] END;
			IF ch # 0X THEN
				j := 0;
				WHILE (ch >= "0") & (ch <= "9") OR (CAP(ch) >= "A") & (CAP(ch) <= "Z") DO
					name[j] := ch; INC(j); INC(i); ch := list[i]
				END;
				name[j] := 0X;
				InsertModule(Kernel.ThisMod(name), done);
				IF done THEN INC(listLen) END
			END
		END
	END SetModuleList;
	
(*
	PROCEDURE GetModuleCount* (name: ARRAY OF CHAR; VAR count: LONGINT);
		VAR i: LONGINT;
	BEGIN
		i := 0;
		WHILE (i < numMod) & (mod[i].mod.name # name) DO INC(i) END;
		IF i < numMod THEN count := mod[i].count
		ELSE count := -1
		END
	END GetModuleCount;
	
	PROCEDURE GetProcedureCount* (modName, procName: ARRAY OF CHAR; VAR count: LONGINT);
		VAR i, j, last, ref, end: LONGINT; name: Kernel.Name;
	BEGIN
		i := 0;
		WHILE (i < numMod) & (mod[i].mod.name # modName) DO INC(i) END;
		IF i < numMod THEN 
			ref := mod[i].mod.refs; j := mod[i].first - 1; last := mod[i].last;
			REPEAT INC(j); Kernel.GetRefProc(ref, end, name); UNTIL (j > last) OR (name = procName);
			IF j <= last THEN count := pCount[j]
			ELSE count := -1
			END
		ELSE count := -1
		END
	END GetProcedureCount;
	
	PROCEDURE GetTotalCount* (VAR inModules, outside: LONGINT);
	BEGIN
		inModules := totalCount;
		outside := otherCount
	END GetTotalCount;
*)	
	(* ---------- menu commands ---------- *)
	
	PROCEDURE Execute*;
		VAR t0: LONGINT; res: INTEGER; str: Dialog.String;
	BEGIN
		t0 := Kernel.Time();
		Dialog.Call("DevDebug.Execute", "", res);
		StdLog.Int(SHORT((Kernel.Time() - t0) * 1000 DIV Kernel.timeResolution));
		Dialog.MapString("#Dev:msec", str);
		StdLog.Char(" "); StdLog.String(str);
		StdLog.Ln
	END Execute;
	
	PROCEDURE NewRuler (): TextRulers.Ruler;
		CONST mm = Ports.mm; pt = Ports.point;
		VAR p: TextRulers.Prop;
	BEGIN
		NEW(p);
		p.valid := {TextRulers.right, TextRulers.tabs, TextRulers.opts};
		p.opts.val := {TextRulers.rightFixed}; p.opts.mask := p.opts.val;
		p.right := 130 * mm;
		p.tabs.len := 5;
		p.tabs.tab[0].stop := 4 * mm; p.tabs.tab[1].stop := 50 * mm;
		p.tabs.tab[2].stop := 54 * mm; p.tabs.tab[3].stop := 70 * mm; 
		p.tabs.tab[4].stop := 74 * mm;
		RETURN TextRulers.dir.NewFromProp(p)
	END NewRuler;

	PROCEDURE ShowModule (VAR m: Module);
		VAR i, p, ref, end: INTEGER; proc, list, a, b: Proc;
	BEGIN
		p := m.count * 100 DIV totalCount;
		IF p > 0 THEN
			out.WriteSString(m.mod.name); out.WriteTab; out.WriteTab;
			out.WriteIntForm(p, 10, 2, "Џ", FALSE); out.WriteLn;
			NEW(proc); list := NIL;
			ref := m.mod.refs; i := m.first;
			WHILE i <= m.last DO
				Kernel.GetRefProc(ref, end, proc.name);
				proc.p := pCount[i] * 100 DIV totalCount;
				IF proc.p > 0 THEN proc.next := list; list := proc; NEW(proc) END;
				INC(i)
			END;
			(* sort list *)
			WHILE list # NIL DO
				a := proc; b := proc.next;
				WHILE (b # NIL) & (list.p < b.p) DO a := b; b := b.next END;
				a.next := list; a := list.next; list.next := b; list := a
			END;
			list := proc.next;
			WHILE list # NIL DO
				out.WriteTab; out.WriteSString(list.name); out.WriteTab; out.WriteTab;
				out.WriteIntForm(list.p, 10, 2, "Џ", FALSE); out.WriteLn;
				list := list.next
			END;
			out.WriteLn;
		END
	END ShowModule;
	
	PROCEDURE ShowProfile*;
		VAR max, limit, maxi, pos, c, n, i: INTEGER; v: TextViews.View; a0: TextModels.Attributes; str: Views.Title;
	BEGIN
		Stop;
		out.ConnectTo(TextModels.dir.New());
		a0 := out.rider.attr;
		out.rider.SetAttr(TextModels.NewStyle(a0, {Fonts.italic}));
		Dialog.MapString("#Dev:Module", str); out.WriteString(str);
		out.WriteTab; out.WriteTab;
		Dialog.MapString("#Dev:PercentPerModule", str); out.WriteString(str);
		out.WriteLn; out.WriteTab;
		Dialog.MapString("#Dev:Procedure", str); out.WriteString(str);
		out.WriteTab; out.WriteTab;
		Dialog.MapString("#Dev:PercentPerProc", str); out.WriteString(str);
		out.WriteLn; out.WriteLn;
		out.rider.SetAttr(a0);
		IF totalCount > 0 THEN
			n := numMod; limit := MAX(INTEGER);
			WHILE n > 0 DO
				i := 0; max := -1;
				WHILE i < numMod DO
					c := mod[i].count;
					IF (c > max) & ((c < limit) OR (c = limit) & (i > pos)) THEN max := c; maxi := i END;
					INC(i)
				END;
				ShowModule(mod[maxi]);
				pos := maxi; limit := max;
				DEC(n)
			END
		END;
		Dialog.MapString("#Dev:Samples", str); out.WriteString(str);
		out.WriteTab; out.WriteTab; out.WriteInt(totalCount + otherCount);
		out.WriteTab; out.WriteTab; out.WriteString("100%"); out.WriteLn;
		out.WriteTab;
		Dialog.MapString("#Dev:InProfiledModules", str); out.WriteString(str);
		out.WriteTab; out.WriteTab; 
		out.WriteInt(totalCount); out.WriteTab; out.WriteTab;
		n := totalCount * 100 DIV (totalCount + otherCount);
		out.WriteInt(n); out.WriteChar("%"); out.WriteLn;
		out.WriteTab;
		Dialog.MapString("#Dev:Other", str); out.WriteString(str);
		out.WriteTab; out.WriteTab; 
		out.WriteInt(otherCount); out.WriteTab; out.WriteTab;
		out.WriteInt(100 - n); out.WriteChar("%"); out.WriteLn;
		v := TextViews.dir.New(out.rider.Base());
		v.SetDefaults(NewRuler(), TextViews.dir.defAttr);
		Dialog.MapString("#Dev:Profile", str);
		Views.OpenAux(v, str);
		out.ConnectTo(NIL)
	END ShowProfile;
	
	PROCEDURE SetProfileList*;
		VAR beg, end: INTEGER; s: TextMappers.Scanner;
			c: TextControllers.Controller; done: BOOLEAN;
	BEGIN
		IF ~started THEN
			Reset;
			c := TextControllers.Focus();
			IF c # NIL THEN
				s.ConnectTo(c.text);
				IF c.HasSelection() THEN c.GetSelection(beg, end)
				ELSE beg := 0; end := c.text.Length()
				END;
				Reset;
				s.SetPos(beg); s.Scan;
				WHILE (s.start < end) & (s.type # TextMappers.eot) DO
					IF s.type = TextMappers.string THEN
						IF numMod < maxMod THEN
							InsertModule(Kernel.ThisMod(s.string), done);
							IF done THEN INC(listLen)
							ELSE Dialog.ShowParamMsg("module ^0 not found", s.string, "", "")
							END
						ELSE
							Dialog.ShowMsg("too many modules");
							RETURN
						END
					END;
					s.Scan
				END
			END
		END
	END SetProfileList;
	
	PROCEDURE StartGuard* (VAR par: Dialog.Par);
	BEGIN
		IF started THEN par.disabled := TRUE END
	END StartGuard;

	PROCEDURE StopGuard* (VAR par: Dialog.Par);
	BEGIN
		IF ~started THEN par.disabled := TRUE END
	END StopGuard;

BEGIN
	Init
END DevProfiler.


STRINGS

msec	msec
Module	Module
PercentPerModule	% per module
Procedure	Procedure
PercentPerProc	% per procedure
Samples	samples:
InProfiledModules	in profiled modules
Other	other
Profile	Profile


Menus

	"Set Profile List"	""	"DevProfiler.SetProfileList"	"DevProfiler.StartGuard"
	"Start Profiler"	""	"DevProfiler.Start"	"DevProfiler.StartGuard"
	"Stop Profiler"	""	"DevProfiler.Stop; DevProfiler.ShowProfile"	"DevProfiler.StopGuard"
	"Execute"	""	"DevProfiler.Execute"	"TextCmds.SelectionGuard"