123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759 |
- 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(" crc "); context.out.Hex(module.crc,-8);
- 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 ~
|