MODULE DevProfiler;
(**
	project	= "BlackBox 2.0"
	organizations	= "Oberon microsystems, BBWFC, OberonCore, BBCP Team"
	contributors	= "Contributors, Ilya E. Ermakov, Ivan Denisov"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "The 2-Clause BSD License"
	changes	= "
	- 20070523, ie, ShowProfile: calculation of samples in profiled modules corrected
	- 20141027, center #19, full Unicode support for Component Pascal identifiers added
	- 20160324, center #111, code cleanups
	- 20170623, Nikita Plynskii, version for Linux with some reduced functions
	- 20230911, dia, moved platform specific part to hook
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		Kernel, Strings, Dialog, Utf, 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.Utf8Name;
			p: INTEGER;
			next: Proc
		END;
		
		ProfilerHook* = POINTER TO ABSTRACT RECORD 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;
		hook: ProfilerHook;

	PROCEDURE SetProfilerHook* (p: ProfilerHook);
	BEGIN
		hook := p
	END SetProfilerHook;

	PROCEDURE (p: ProfilerHook) Count* (pc: INTEGER), NEW;
		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;

	PROCEDURE (p: ProfilerHook) StartRecording*, NEW, ABSTRACT;

	PROCEDURE (p: ProfilerHook) StopRecording*, NEW, ABSTRACT;


	(* ---------- 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.Utf8Name; m: Kernel.Module; ok: BOOLEAN;
	BEGIN
		IF hook = NIL THEN
			StdLog.String("no profiler for platform"); StdLog.Ln;
		ELSE
			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 hook.StartRecording END;
				started := TRUE
			END
		END
	END Start;
	
	PROCEDURE Stop*;
	BEGIN
		IF hook = NIL THEN
			StdLog.String("no profiler for platform"); StdLog.Ln;
		ELSE
			IF started THEN
				hook.StopRecording;
				started := FALSE
			END
		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) & ~Strings.IsIdentStart(ch) DO INC(i); ch := list[i] END;
			IF ch # 0X THEN
				j := 0;
				WHILE Strings.IsIdent(ch) 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.Utf8Name;
	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;
		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; modName, nn: Kernel.Name; res: INTEGER;
	BEGIN
		ASSERT(totalCount > 0, 20);
		p := m.count * 100 DIV totalCount;
		IF p > 0 THEN
			Kernel.GetModName(m.mod, modName); out.WriteString(modName); 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
				Utf.Utf8ToString(list.name, nn, res); out.WriteTab; out.WriteString(nn); 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); pos := -1;
			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;
		IF totalCount + otherCount > 0 THEN
			n := totalCount * 100 DIV (totalCount + otherCount)
		ELSE
			n := 0
		END;
		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;
	
	PROCEDURE Init;
	BEGIN
		IF Dialog.platform = Dialog.windows THEN
			Kernel.LoadMod("DevProfiler__Win")
		END
	END Init;

BEGIN
	Init
END DevProfiler.
