A2OS/source/SystemTools.Mod

MODULE SystemTools; (** AUTHOR "TF"; PURPOSE "Access to System Functions"; *)

IMPORT
	Machine, Modules, Objects, Commands, Options, ProcessInfo, Kernel, Streams, Dates, Strings, Plugins, Files, SystemVersion, Heaps, Reflection;

CONST
	MaxTimers = 16;

	DateTimeFormat = "dd.mm.yyyy hh:nn:ss";

	CR = 0DX;  LF = 0AX;  TAB = 9X;

	TraceCommands = 1;
	TraceFreeDownTo = 2;

	Trace = {};

	OberonKernel = "Oberon.Kernel";

TYPE

	Module = POINTER TO RECORD
		next: Module;
		checked, imports: BOOLEAN;
		m: Modules.Module
	END;

VAR
	timers : ARRAY MaxTimers OF Dates.DateTime;

PROCEDURE Find(root: Module; m: Modules.Module): Module;
BEGIN
	WHILE (root # NIL) & (root.m # m) DO root := root.next END;
	RETURN root
END Find;

PROCEDURE CopyModules(): Module;
VAR first, last, c: Module; m: Modules.Module;
BEGIN
	NEW(first); first.next := NIL; last := first;
	m := Modules.root;
	WHILE m # NIL DO
		NEW(c); c.checked := FALSE; c.imports := FALSE; c.m := m;
		c.next := NIL; last.next := c; last := c;
		m := m.next
	END;
	RETURN first.next
END CopyModules;

PROCEDURE Imports(root, m: Module; CONST name: ARRAY OF CHAR): BOOLEAN;
VAR i: LONGINT;
BEGIN
	IF ~m.checked THEN
		IF m.m.name # name THEN
			i := 0;
			WHILE i # LEN(m.m.module) DO
				IF (m.m.module[i].name = name) OR Imports(root, Find(root, m.m.module[i]), name) THEN
					m.imports := TRUE; i := LEN(m.m.module)
				ELSE
					INC(i)
				END
			END
		ELSE
			m.imports := TRUE
		END;
		m.checked := TRUE
	END;
	RETURN m.imports
END Imports;

PROCEDURE LockOberon;
VAR c: PROCEDURE;
BEGIN
	IF Modules.ModuleByName (OberonKernel) # NIL THEN
		GETPROCEDURE (OberonKernel, "LockOberon", c);
		IF c # NIL THEN c END
	END;
END LockOberon;

PROCEDURE UnlockOberon;
VAR c: PROCEDURE;
BEGIN
	IF Modules.ModuleByName (OberonKernel) # NIL THEN
		GETPROCEDURE (OberonKernel, "UnlockOberon", c);
		IF c # NIL THEN c END
	END;
END UnlockOberon;

(** List all currently loaded modules *)
PROCEDURE ListModules*(context : Commands.Context);
VAR m: Modules.Module; options: Options.Options; details: BOOLEAN; first, reverse: BOOLEAN;

	PROCEDURE List(m: Modules.Module);
	BEGIN
		IF m = NIL THEN RETURN END;
		IF reverse THEN List(m.next) END;
		IF ~first & options.GetFlag("l") THEN context.out.Ln ELSE context.out.String(" ") END;
		first := FALSE;
		context.out.String(m.name);
		IF options.GetFlag("crc") THEN context.out.String(" crc="); context.out.Hex(m.crc,-8); context.out.String("") END;
		IF~reverse THEN List(m.next) END;
	END List;
	

BEGIN
	NEW(options);
	options.Add("c", "crc", Options.Flag);
	options.Add("l", "ln", Options.Flag);
	options.Add("b", "base", Options.Flag);
	options.Add("r", "reverse", Options.Flag);
	IF options.Parse(context.arg, context.error) THEN
		reverse := ~options.GetFlag("r");
		first := FALSE;
		List(Modules.root);
	END;
END ListModules;

(** List all loaded plugins. *)
PROCEDURE ListPlugins*(context : Commands.Context);
VAR r, p : Plugins.Table; i, j : LONGINT;
BEGIN
	Plugins.main.GetAll(r);
	IF r # NIL THEN
		FOR i := 0 TO LEN(r^)-1 DO
			context.out.Int(i, 1); context.out.Char(" ");
			context.out.String(r[i].name); context.out.Char(" ");
			context.out.String(r[i].desc); context.out.Ln;
			r[i](Plugins.Registry).GetAll(p);
			IF p # NIL THEN
				FOR j := 0 TO LEN(p^)-1 DO
					context.out.Char(TAB); context.out.Int(j, 1); context.out.Char(" ");
					context.out.String(p[j].name); context.out.Char(" ");
					context.out.String(p[j].desc); context.out.Ln;
					context.out.Update;
				END;
			END
		END
	END;
END ListPlugins;

(** List all  commands of the specified module. *)
PROCEDURE ListCommands*(context : Commands.Context); (** module *)
VAR m : Modules.Module; moduleName : Modules.Name; i : LONGINT;
BEGIN
	context.arg.SkipWhitespace;
	context.arg.String(moduleName);
	m := Modules.ModuleByName(moduleName);
	IF m # NIL THEN
		FOR i := 0 TO LEN(m.command)-1 DO
			context.out.String(m.name); context.out.Char(".");
			context.out.String(m.command[i].name);
			context.out.Ln;
		END
	ELSE
		context.error.String("Module not found"); context.error.Ln
	END;
END ListCommands;

PROCEDURE List*(context : Commands.Context);
VAR string : ARRAY 32 OF CHAR;
BEGIN
	context.arg.SkipWhitespace;
	context.arg.String(string);
	IF (string = "plugins") THEN ListPlugins(context);
	ELSIF (string = "modules") THEN ListModules(context);
	ELSIF (string = "commands") THEN ListCommands(context);
	ELSE
		context.error.String('Usage: SystemTools.List ("plugins"|"modules"|("commands" moduleName))');
		context.error.Ln;
	END;
END List;

PROCEDURE ModuleIsLoaded(CONST name : Modules.Name) : BOOLEAN;
BEGIN
	RETURN Modules.ModuleByName(name) # NIL;
END ModuleIsLoaded;

(** Show all modules that import 'basemodule' (transitively) and are currently loaded. *)

PROCEDURE WhoImports*(context : Commands.Context); (** basemodule ~ *)
VAR name : Modules.Name; root, m : Module;
BEGIN
	context.arg.SkipWhitespace;
	context.arg.String(name);
	IF ModuleIsLoaded(name) THEN
		root := CopyModules();
		m := root;
		WHILE m # NIL DO
			IF Imports(root, m, name) THEN
				context.out.String(m.m.name); context.out.Ln;
			END;
			m := m.next;
		END;
	ELSE
		context.error.String("Module "); context.error.String(name); context.error.String(" is not loaded."); context.error.Ln;
	END;
END WhoImports;

(** Check whether the specified module is currenlty loaded. *)

PROCEDURE IsLoaded*(context : Commands.Context);
VAR name : Modules.Name;
BEGIN
	context.arg.SkipWhitespace;
	context.arg.String(name);
	context.out.String("Module "); context.out.String(name);
	IF ModuleIsLoaded(name) THEN
		context.out.String(" is loaded.");
	ELSE
		context.out.String(" is not loaded.");
	END;
	context.out.Ln;
END IsLoaded;

PROCEDURE ModuleState*(context: Commands.Context);
VAR name: Modules.Name; module: Modules.Module; msg: ARRAY 256 OF CHAR; res: LONGINT;
BEGIN	
	context.arg.SkipWhitespace;
	context.arg.String(name);
	module := Modules.ThisModule(name, res, msg);
	context.result := res;
	IF (res = Modules.Ok) THEN
		context.out.String(name); context.out.String(" state: "); context.out.Ln;
		Reflection.ModuleState(context.out, module);
	ELSE
		context.error.String("Could not load module "); context.error.String(name);
		context.error.String(", res: "); context.error.Int(res, 0);
		IF (msg # "") THEN
			context.error.String(" ("); context.error.String(msg); context.error.String(")");
		END;
		context.error.Ln;
	END;
	
END ModuleState;


(** Load the specified module *)
PROCEDURE Load*(context : Commands.Context); (** modulename ~ *)
VAR name : Modules.Name; module : Modules.Module; msg : ARRAY 256 OF CHAR; res : LONGINT;
BEGIN
	context.arg.SkipWhitespace;
	context.arg.String(name);
	IF ModuleIsLoaded(name) THEN
		context.result := Modules.Ok;
		context.out.String(name); context.out.String(" is already loaded."); context.out.Ln;
	ELSE
		module := Modules.ThisModule(name, res, msg);
		context.result := res;
		IF (res = Modules.Ok) THEN
			context.out.String(name); context.out.String(" loaded."); context.out.Ln;
		ELSE
			context.error.String("Could not load module "); context.error.String(name);
			context.error.String(", res: "); context.error.Int(res, 0);
			IF (msg # "") THEN
				context.error.String(" ("); context.error.String(msg); context.error.String(")");
			END;
			context.error.Ln;
		END;
	END;
END Load;

(** Free all modules that import basemodule (transitively). *)
PROCEDURE FreeDownTo*(context : Commands.Context); (** basemodule ~ *)
VAR
	modulename : ARRAY 128 OF CHAR;
	root, m: Module; res: LONGINT;
	timer: Kernel.Timer; msg: ARRAY 64 OF CHAR;
	nbrOfUnloadedModules : LONGINT;
BEGIN
	context.arg.SkipWhitespace;
	context.arg.String(modulename);
	LockOberon;
	NEW(timer); timer.Sleep(200); (* temporary workaround for race with System.FreeOberon *)
	root := CopyModules();

	nbrOfUnloadedModules := 0;
	m := root;
	WHILE m # NIL DO
		IF Imports(root, m, modulename) THEN
			IF TraceFreeDownTo IN Trace  THEN
				context.out.String(m.m.name); context.out.Ln;
			END;
			Modules.FreeModule(m.m.name, res, msg);
			IF res # 0 THEN
				context.error.String(msg);
			ELSE
				INC(nbrOfUnloadedModules);
			END
		END;
		m := m.next
	END;
	UnlockOberon; (* in case Oberon still running *)
	context.out.String("Unloaded "); context.out.Int(nbrOfUnloadedModules, 0); context.out.String(" modules."); context.out.Ln;
END FreeDownTo;

(** Unload modules from memory *)
PROCEDURE Free*(context : Commands.Context); (** {modulename} ~ *)
VAR name, msg : ARRAY 64 OF CHAR; res : LONGINT;
BEGIN
	WHILE context.arg.GetString(name) DO
		IF name # "" THEN
			context.out.String("Unloading "); context.out.String(name); context.out.String("... ");
			Modules.FreeModule(name, res, msg);
			IF res # 0 THEN context.out.String(msg)
			ELSE context.out.String("done.")
			END;
			context.out.Ln;
		END;
	END;
END Free;

PROCEDURE Kill*(context : Commands.Context); (** pid { pid } ~ *)
VAR process : Objects.Process; pid : LONGINT;
BEGIN {EXCLUSIVE}
	WHILE context.arg.GetInteger(pid, FALSE) DO
		context.out.Int(pid, 0);
		process := ProcessInfo.GetProcess(pid);
		IF process # NIL THEN
			Objects.TerminateThis(process, FALSE);
			context.out.String(" Process killed")
		ELSE
			context.out.String(" Process not found")
		END;
		context.out.Ln;
	END;
END Kill;

PROCEDURE ShowProcesses*(context : Commands.Context); (** [options] ~ *)
VAR
	options : Options.Options;
	processes : ARRAY ProcessInfo.MaxNofProcesses OF Objects.Process;
	nofProcesses : LONGINT;
	string : ARRAY 16 OF CHAR;
	i : LONGINT;
BEGIN
	NEW(options);
	options.Add("s", "sort", Options.String);
	IF options.Parse(context.arg, context.error) THEN
		ProcessInfo.GetProcesses(processes, nofProcesses);
		IF options.GetString("sort", string) THEN
			IF (string = "id") THEN
				ProcessInfo.Sort(processes, nofProcesses, ProcessInfo.SortByID);
			ELSIF (string = "priority") THEN
				ProcessInfo.Sort(processes, nofProcesses, ProcessInfo.SortByPriority);
			ELSIF (string = "mode") THEN
				ProcessInfo.Sort(processes, nofProcesses, ProcessInfo.SortByMode);
			ELSE
				context.error.String("Sort option "); context.error.String(string);
				context.error.String(" unknown... ignore."); context.error.Ln;
			END;
		END;
		FOR i := 0 TO nofProcesses - 1 DO ProcessInfo.ShowProcess(processes[i], context.out); END;
		context.out.Int(nofProcesses, 0); context.out.String(" processes"); context.out.Ln;
		ProcessInfo.Clear(processes);
	END;
END ShowProcesses;

PROCEDURE ShowStacks*(context : Commands.Context);
VAR processes : ARRAY ProcessInfo.MaxNofProcesses OF Objects.Process; nofProcesses, i : LONGINT;
BEGIN
	ProcessInfo.GetProcesses(processes, nofProcesses);
	FOR i := 0 TO nofProcesses - 1 DO ProcessInfo.ShowStack(processes[i], context.out); END;
	ProcessInfo.Clear(processes);
END ShowStacks;

PROCEDURE ShowStack*(context : Commands.Context); (** pid ~ *)
VAR process : Objects.Process; pid : LONGINT;
BEGIN
	context.arg.SkipWhitespace;
	context.arg.Int(pid, FALSE);
	process := ProcessInfo.GetProcess(pid);
	IF (process # NIL) THEN
		context.out.String("Stack of process ID = "); context.out.Int(pid, 0); context.out.Ln;
		ProcessInfo.ShowStack(process, context.out);
	ELSE
		context.error.String("Process ID = "); context.error.Int(pid, 0); context.error.String(" not found.");
		context.error.Ln;
	END;
END ShowStack;

(** Inspect free Heaps space *)
PROCEDURE Watch*(context : Commands.Context);
VAR total, free, largest: SIZE;
BEGIN
	Heaps.GetHeapInfo(total,free,largest);
	context.out.String("Heaps: total="); context.out.Int(total,0);
	context.out.String(" bytes; free="); context.out.Int(free,0);
	context.out.String(" bytes; largest free block size="); context.out.Int(largest,0);
	context.out.String(" bytes"); context.out.Ln;
END Watch;

(* Changes the extension, Usage: RenameExtension extFrom extTo~ *)
PROCEDURE RenameExtension*(context : Commands.Context);
VAR
	enumerator : Files.Enumerator;
	oe, ne, temp: ARRAY 16 OF CHAR;
	name, file, ext : Files.FileName; flags : SET; time, date, size, res : LONGINT;
BEGIN
	context.arg.SkipWhitespace; context.arg.String(oe);
	context.arg.SkipWhitespace; context.arg.String(ne);
	NEW(enumerator);
	temp := "*.";
	Strings.Append(temp, oe);
	enumerator.Open(temp, {});
	temp := ".";
	Strings.Append(temp, ne);
	context.out.String("-- Renaming Extension --"); context.out.Ln;
	WHILE enumerator.HasMoreEntries() DO
		IF enumerator.GetEntry(name, flags, time, date, size) THEN
			Strings.GetExtension(name, file, ext);
			Strings.Append(file, temp);
			context.out.String("Renaming: "); context.out.String(name); context.out.String(" to: "); context.out.String(file);
			Files.Rename(name, file, res);
			IF res = 0 THEN context.out.String("    done"); ELSE context.out.String("   Error!"); END;
			context.out.Ln;
		END;
	END;
	context.out.String("-- all done --"); context.out.Ln;
	enumerator.Close;
END RenameExtension;

PROCEDURE IsDelimiter(ch : CHAR) : BOOLEAN;
BEGIN
	RETURN (ch = " ") OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (ch = ";") OR (ch = 0X);
END IsDelimiter;

PROCEDURE DoFile*(context: Commands.Context);
VAR 
	newContext: Commands.Context;
	file: Files.File; 
	r: Streams.Reader;
	filename: Files.FileName;
	res: LONGINT;
	msg: ARRAY 256 OF CHAR;
BEGIN
	IF context.arg.GetString(filename) THEN
		file := Files.Old(filename); 
		IF file # NIL THEN
			r := NEW Files.Reader(file, 0);
			NEW(newContext, context.in, r, context.out, context.error, context.caller);
			Commands.Activate("SystemTools.DoCommands", newContext, {Commands.Wait}, res, msg);
		ELSE
			context.error.String("Error: no such file: "); context.error.String(filename); context.error.Ln;
		END;
	ELSE
		context.error.String("Error: mo filename provided."); context.error.String(filename); context.error.Ln;
	END;
END DoFile;


(** Sequentially execute a list of commands .
IMPORTANT: This command is specially handled by command interpreters that support it. It is the only command
in the system for which two tilde characters (only separated by whitespace) are used to delimit the parameter string.
If you change the name of this module or this command, you have to adapt:
- WMTextView.TextView.FindCommandRange *)
PROCEDURE DoCommands*(context : Commands.Context); (** command {"~" command}  "~" *)
VAR
	newContext : Commands.Context;
	commands : Strings.StringArray;
	command, parameters, paramString : Strings.String;
	temp : Strings.String;
	msg : ARRAY 128 OF CHAR;
	cur, available, i, j, k, res : LONGINT;

	PROCEDURE CreateContext(paramString : Strings.String) : Commands.Context;
	VAR c : Commands.Context; arg : Streams.StringReader; dummy : ARRAY 1 OF CHAR;
	BEGIN
		IF (paramString = NIL) THEN
			NEW(arg, 1); dummy := ""; arg.SetRaw(dummy, 0, 1);
		ELSE
			NEW(arg, LEN(paramString)); arg.SetRaw(paramString^, 0, LEN(paramString));
		END;
		NEW(c, context.in, arg, context.out, context.error, context.caller);
		RETURN c;
	END CreateContext;

	PROCEDURE Resize(VAR t: Strings.String; len: LONGINT);
	VAR new: Strings.String; i: LONGINT;
	BEGIN
		NEW(new, len);
		IF t # NIL THEN
			FOR i := 0 TO LEN(t)-1 DO new[i] := t[i] END;
		END;
		t := new;
	END Resize;


BEGIN
	cur := context.arg.Available();
	IF (cur < 1) THEN RETURN; END;
	NEW(temp, cur + 1);
	available := 0;
	WHILE cur > 0 DO
		Resize(temp, available+cur+1);
		context.arg.Bytes(temp^, available, cur, i); (* ignore i *)
		INC(available, cur);
		cur := context.arg.Available();
	END;

	RemoveComments(temp^, available);
	Strings.Truncate (temp^, available);
	commands := Strings.Split(temp^, "~");

	NEW(command, LEN(temp)); NEW(parameters, LEN(temp));
	i := 0;
	LOOP
		Strings.TrimWS(commands[i]^);

		IF (commands[i]^ = "") THEN
			(* This means that two tilde characters were only separated by whitespace. One delimits
			the last command we have executed and the other one delimits the SystemTools.DoCommands parameters *)
			EXIT;
		END;

		(* extract command *)
		j := 0; k := 0;
		WHILE ~IsDelimiter(commands[i][j])  DO command[k] := commands[i][j]; INC(k); INC(j); END;
		command[k] := 0X;
		IF k = 0 THEN EXIT; END;	(* end of string *)

		(* extract parameters *)
		k := 0;
		IF (commands[i][j] # "~") & (commands[i][j] # 0X) THEN
			INC(j); WHILE (commands[i][j] # 0X) & (commands[i][j] # "~") DO parameters[k] := commands[i][j]; INC(k); INC(j); END;
			parameters[k] := 0X;
		END;
		IF k > 0 THEN
			NEW(paramString, k+1);
			FOR j := 0 TO k DO paramString[j] := parameters[j]; END;
		ELSE
			paramString := NIL;
		END;
		newContext := CreateContext(paramString);

		IF TraceCommands IN Trace THEN
			context.out.String("SystemTools.DoCommands: Execute command '"); context.out.String(command^);
			context.out.String("' parameters: ");
			IF (paramString = NIL) THEN context.out.String("None");
			ELSE
				context.out.String("'"); context.out.String(paramString^); context.out.String("'");
			END;
			context.out.Ln;
		END;

		Commands.Activate(command^, newContext, {Commands.Wait}, res, msg);

		IF res # Commands.Ok THEN
			context.error.String("SystemTools.DoCommands: Command: '");
			context.error.String(command^); context.error.String("', parameters: ");
			IF paramString = NIL THEN
				context.error.String("None");
			ELSE
				context.error.String("'"); context.error.String(paramString^); context.error.String("'");
			END;
			context.error.String(" failed: ");
			context.error.String(msg); context.error.String(" (res: "); context.error.Int(res, 0); context.error.String(")");
			context.error.Ln;
			EXIT;
		END;
		INC(i);
		IF i >= LEN(commands) THEN EXIT; END;
	END;
END DoCommands;

(** remove Oberon style comments (parantheses and asterisks) from a string of a certain length.
- comments may be nested arbitrarily
- the operation is performed in situ: comments are replaced with whitespace characters
**)
PROCEDURE RemoveComments(VAR string: ARRAY OF CHAR; length: LONGINT);
VAR
	pos, level: LONGINT;
BEGIN
	level := 0;
	pos := 0;
	WHILE pos <= length - 1 DO
		IF (string[pos] = '(') & (pos + 1 <= length - 1) & (string[pos + 1] = '*') THEN
			(* a comment opened -> replace *)
			INC(level);
			string[pos] := ' '; string[pos + 1] := ' '; INC(pos, 2)
		ELSIF (string[pos] = '*') & (pos + 1 <= length - 1) & (string[pos + 1] = ')') THEN
			(* a comment is closed -> replace *)
			DEC(level);
			string[pos] := ' '; string[pos + 1] := ' '; INC(pos, 2)
		ELSIF level <= 0 THEN
			(* character outside any comment -> leave as is *)
			INC(pos)
		ELSE
			(* character within a comment -> replace *)
			string[pos] := ' '; INC(pos)
		END
	END
END RemoveComments;

PROCEDURE Repeat*(context : Commands.Context); (* nofTimes command [command parameters] ~ *)
VAR
	command, msg : ARRAY 128 OF CHAR;
	parameterPosition : LONGINT;
	nofTimes, res : LONGINT;
BEGIN
	nofTimes := 0; command := "";
	context.arg.SkipWhitespace;	context.arg.Int(nofTimes, FALSE);
	context.arg.SkipWhitespace;	context.arg.String(command);
	IF (nofTimes > 0) & (command # "") THEN
		res := Commands.Ok;
		parameterPosition := context.arg.Pos();
		WHILE (nofTimes > 0) & (res = Commands.Ok) DO
			context.arg.SetPos(parameterPosition);
			Commands.Activate(command, context, {Commands.Wait}, res, msg);
			DEC(nofTimes);
		END;
		IF (res # Commands.Ok) THEN
			context.out.String("Error in command '"); context.out.String(command); context.out.String("', res: ");
			context.out.Int(res, 0); context.out.Ln;
		END;
	END;
END Repeat;

(** Time interval measurement
 	- start/starth [number]: Set timer <number> to current time (number = 0 if omitted)
  	- elapsed/elapsedh [number]: Display time difference between timer <number> and the current time (number = 0 if omitted)
	- diff/diffh number1 number2: Display time difference between the two timers
	*)
PROCEDURE Timer*(context : Commands.Context); (** [  ["start"["h"] [number]] | ["elapsed"["h"] [number]] | ["diff"["h"] number1 number2]  ] ~ *)
VAR
	string : ARRAY 128 OF CHAR; nbr1, nbr2 : LONGINT;

	PROCEDURE ShowUsage;
	BEGIN
		context.out.String('Usage: SystemTools.Timer  [  ["start" [number]] | ["elapsed" [number]] | ["diff" number1 number2]  ]');
		context.out.Ln;
	END ShowUsage;

	PROCEDURE Valid(number : LONGINT) : BOOLEAN;
	BEGIN
		RETURN (0 <= number) & (number < MaxTimers);
	END Valid;

BEGIN {EXCLUSIVE}
	context.arg.SkipWhitespace;	context.arg.String(string);
	context.arg.SkipWhitespace;	context.arg.Int(nbr1, FALSE);
	context.arg.SkipWhitespace;	context.arg.Int(nbr2, FALSE);

	IF ~Valid(nbr1) THEN ShowUsage; RETURN; END;

	IF (string = "start") THEN
		timers[nbr1] := Dates.Now();
	ELSIF (string = "elapsed") THEN
		Strings.ShowTimeDifference(timers[nbr1], Dates.Now(), context.out);
	ELSIF Valid(nbr2) THEN
		IF (string = "diff") THEN
			Strings.ShowTimeDifference(timers[nbr1], timers[nbr2], context.out);
		ELSE
			ShowUsage;
		END;
	ELSE
		ShowUsage;
	END;
END Timer;

(** If no parameter is specified, this command displays the system time on Kernel Log. *)
PROCEDURE Time*(context : Commands.Context); (** ~ *)
VAR datetime : Dates.DateTime; string : ARRAY 32 OF CHAR;
BEGIN
	datetime := Dates.Now();
	Strings.FormatDateTime(DateTimeFormat, datetime, string);
	context.out.String(string); context.out.Ln;
END Time;

(** Display the content of the specified file *)
PROCEDURE ShowFile*(context : Commands.Context); (** filename ~ *)
VAR filename : Files.FileName; file : Files.File; reader : Files.Reader; ch : CHAR;
BEGIN
	IF context.arg.GetString(filename) THEN
		file := Files.Old(filename);
		IF (file # NIL) THEN
			Files.OpenReader(reader, file, 0);
			REPEAT
				reader.Char(ch);
				context.out.Char(ch);
			UNTIL (reader.res # Streams.Ok);
		ELSE
			context.error.String("Could not open file "); context.error.String(filename); context.error.Ln;
		END;
	END;
END ShowFile;

(** Display a string on the context output stream  *)
PROCEDURE Show*(context : Commands.Context); (** string ~ *)
VAR ch : CHAR;
BEGIN
	REPEAT
		ch := context.arg.Get();
		IF (ch # 0X) THEN context.out.Char(ch); END;
	UNTIL (context.arg.res # Streams.Ok);
END Show;

(** Print carriage return on the context output stream *)
PROCEDURE Ln*(context : Commands.Context); (** ~ *)
BEGIN
	context.out.Ln;
END Ln;

(** Block for ms milliseconds *)
PROCEDURE Wait*(context : Commands.Context); (** ms ~ *)
VAR timer : Kernel.Timer; milliseconds : LONGINT;
BEGIN
	IF context.arg.GetInteger(milliseconds, FALSE) & (milliseconds > 0) THEN
		NEW(timer);
		timer.Sleep(milliseconds);
	END;
END Wait;

PROCEDURE Reboot*;
BEGIN
	Modules.Shutdown(Modules.Reboot);
END Reboot;

PROCEDURE PowerDown*;
BEGIN
	Modules.Shutdown(Modules.PowerDown);
END PowerDown;

(** Invoke garbage collector *)
PROCEDURE CollectGarbage*(context : Commands.Context);
BEGIN
	context.out.String("Collecting garbage... ");
	Kernel.GC;
	context.out.String("done."); context.out.Ln;
END CollectGarbage;

PROCEDURE Version*(context : Commands.Context);
BEGIN
	context.out.String(Machine.version);context.out.String(" Kernel CRC="); context.out.Hex(SystemVersion.BootCRC, 8);  context.out.Ln;
END Version;

END SystemTools.

SystemTools.Free SystemTools  ~
SystemTools.Kill 57 ~

SystemTools.Time ~
SystemTools.Show Hello World ~

SystemTools.DoCommands
	SystemTools.Timer start ~
	SystemTools.Show System Time ~ SystemTools.Time ~ SystemTools.Ln ~
	SystemTools.Show System Time again ~ SystemTools.Time ~ SystemTools.Ln ~
	SystemTools.Wait 2000 ~
	SystemTools.Show Time elapsed: ~ SystemTools.Timer elapsed ~ SystemTools.Ln ~
~

SystemTools.CollectGarbage ~

SystemTools.ListModules -r ~

SystemTools.ModuleState Heaps ~