MODULE SystemTools;
IMPORT
Machine, Modules, Objects, Commands, Options, ProcessInfo, Kernel, Streams, Dates, Strings, Plugins, Files, SystemVersion;
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;
PROCEDURE ListModules*(context : Commands.Context);
VAR m: Modules.Module; options: Options.Options; details: BOOLEAN;
BEGIN
NEW(options);
options.Add("c", "crc", Options.Flag);
options.Add("l", "ln", Options.Flag);
IF options.Parse(context.arg, context.error) THEN
m := Modules.root;
WHILE m # NIL DO
context.out.String(m.name);
IF options.GetFlag("crc") THEN context.out.String(" crc="); context.out.Hex(m.crc,-8); context.out.String("") END;
m := m.next;
IF m # NIL THEN
IF options.GetFlag("l") THEN context.out.Ln ELSE context.out.String(" ") END;
ELSE
context.out.Ln
END;
END;
END;
END ListModules;
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;
PROCEDURE ListCommands*(context : Commands.Context);
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;
PROCEDURE WhoImports*(context : Commands.Context);
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;
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 Load*(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);
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;
PROCEDURE FreeDownTo*(context : Commands.Context);
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);
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;
context.out.String("Unloaded "); context.out.Int(nbrOfUnloadedModules, 0); context.out.String(" modules."); context.out.Ln;
END FreeDownTo;
PROCEDURE Free*(context : Commands.Context);
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);
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);
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);
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;
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 DoCommands*(context : Commands.Context);
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);
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
EXIT;
END;
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;
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;
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
INC(level);
string[pos] := ' '; string[pos + 1] := ' '; INC(pos, 2)
ELSIF (string[pos] = '*') & (pos + 1 <= length - 1) & (string[pos + 1] = ')') THEN
DEC(level);
string[pos] := ' '; string[pos + 1] := ' '; INC(pos, 2)
ELSIF level <= 0 THEN
INC(pos)
ELSE
string[pos] := ' '; INC(pos)
END
END
END RemoveComments;
PROCEDURE Repeat*(context : Commands.Context);
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;
PROCEDURE Timer*(context : Commands.Context);
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;
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;
PROCEDURE ShowFile*(context : Commands.Context);
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;
PROCEDURE Show*(context : Commands.Context);
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;
PROCEDURE Ln*(context : Commands.Context);
BEGIN
context.out.Ln;
END Ln;
PROCEDURE Wait*(context : Commands.Context);
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;
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 S ~
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 ~