2
0

SystemTools.Mod 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691
  1. MODULE SystemTools; (** AUTHOR "TF"; PURPOSE "Access to System Functions"; *)
  2. IMPORT
  3. Machine, Modules, Objects, Commands, Options, ProcessInfo, Kernel, Streams, Dates, Strings, Plugins, Files, SystemVersion;
  4. CONST
  5. MaxTimers = 16;
  6. DateTimeFormat = "dd.mm.yyyy hh:nn:ss";
  7. CR = 0DX; LF = 0AX; TAB = 9X;
  8. TraceCommands = 1;
  9. TraceFreeDownTo = 2;
  10. Trace = {};
  11. OberonKernel = "Oberon.Kernel";
  12. TYPE
  13. Module = POINTER TO RECORD
  14. next: Module;
  15. checked, imports: BOOLEAN;
  16. m: Modules.Module
  17. END;
  18. VAR
  19. timers : ARRAY MaxTimers OF Dates.DateTime;
  20. PROCEDURE Find(root: Module; m: Modules.Module): Module;
  21. BEGIN
  22. WHILE (root # NIL) & (root.m # m) DO root := root.next END;
  23. RETURN root
  24. END Find;
  25. PROCEDURE CopyModules(): Module;
  26. VAR first, last, c: Module; m: Modules.Module;
  27. BEGIN
  28. NEW(first); first.next := NIL; last := first;
  29. m := Modules.root;
  30. WHILE m # NIL DO
  31. NEW(c); c.checked := FALSE; c.imports := FALSE; c.m := m;
  32. c.next := NIL; last.next := c; last := c;
  33. m := m.next
  34. END;
  35. RETURN first.next
  36. END CopyModules;
  37. PROCEDURE Imports(root, m: Module; CONST name: ARRAY OF CHAR): BOOLEAN;
  38. VAR i: LONGINT;
  39. BEGIN
  40. IF ~m.checked THEN
  41. IF m.m.name # name THEN
  42. i := 0;
  43. WHILE i # LEN(m.m.module) DO
  44. IF (m.m.module[i].name = name) OR Imports(root, Find(root, m.m.module[i]), name) THEN
  45. m.imports := TRUE; i := LEN(m.m.module)
  46. ELSE
  47. INC(i)
  48. END
  49. END
  50. ELSE
  51. m.imports := TRUE
  52. END;
  53. m.checked := TRUE
  54. END;
  55. RETURN m.imports
  56. END Imports;
  57. PROCEDURE LockOberon;
  58. VAR c: PROCEDURE;
  59. BEGIN
  60. IF Modules.ModuleByName (OberonKernel) # NIL THEN
  61. GETPROCEDURE (OberonKernel, "LockOberon", c);
  62. IF c # NIL THEN c END
  63. END;
  64. END LockOberon;
  65. PROCEDURE UnlockOberon;
  66. VAR c: PROCEDURE;
  67. BEGIN
  68. IF Modules.ModuleByName (OberonKernel) # NIL THEN
  69. GETPROCEDURE (OberonKernel, "UnlockOberon", c);
  70. IF c # NIL THEN c END
  71. END;
  72. END UnlockOberon;
  73. (** List all currently loaded modules *)
  74. PROCEDURE ListModules*(context : Commands.Context);
  75. VAR m: Modules.Module; options: Options.Options; details: BOOLEAN;
  76. BEGIN
  77. NEW(options);
  78. options.Add("c", "crc", Options.Flag);
  79. options.Add("l", "ln", Options.Flag);
  80. options.Add("b", "base", Options.Flag);
  81. IF options.Parse(context.arg, context.error) THEN
  82. m := Modules.root;
  83. WHILE m # NIL DO
  84. context.out.String(m.name);
  85. (*IF options.GetFlag("base") THEN context.out.String(" base="); context.out.Hex(m.firstProc,-8) END;*)
  86. IF options.GetFlag("crc") THEN context.out.String(" crc="); context.out.Hex(m.crc,-8); context.out.String("") END;
  87. m := m.next;
  88. IF m # NIL THEN
  89. IF options.GetFlag("l") THEN context.out.Ln ELSE context.out.String(" ") END;
  90. ELSE
  91. context.out.Ln
  92. END;
  93. END;
  94. END;
  95. END ListModules;
  96. (** List all loaded plugins. *)
  97. PROCEDURE ListPlugins*(context : Commands.Context);
  98. VAR r, p : Plugins.Table; i, j : LONGINT;
  99. BEGIN
  100. Plugins.main.GetAll(r);
  101. IF r # NIL THEN
  102. FOR i := 0 TO LEN(r^)-1 DO
  103. context.out.Int(i, 1); context.out.Char(" ");
  104. context.out.String(r[i].name); context.out.Char(" ");
  105. context.out.String(r[i].desc); context.out.Ln;
  106. r[i](Plugins.Registry).GetAll(p);
  107. IF p # NIL THEN
  108. FOR j := 0 TO LEN(p^)-1 DO
  109. context.out.Char(TAB); context.out.Int(j, 1); context.out.Char(" ");
  110. context.out.String(p[j].name); context.out.Char(" ");
  111. context.out.String(p[j].desc); context.out.Ln;
  112. context.out.Update;
  113. END;
  114. END
  115. END
  116. END;
  117. END ListPlugins;
  118. (** List all commands of the specified module. *)
  119. PROCEDURE ListCommands*(context : Commands.Context); (** module *)
  120. VAR m : Modules.Module; moduleName : Modules.Name; i : LONGINT;
  121. BEGIN
  122. context.arg.SkipWhitespace;
  123. context.arg.String(moduleName);
  124. m := Modules.ModuleByName(moduleName);
  125. IF m # NIL THEN
  126. FOR i := 0 TO LEN(m.command)-1 DO
  127. context.out.String(m.name); context.out.Char(".");
  128. context.out.String(m.command[i].name);
  129. context.out.Ln;
  130. END
  131. ELSE
  132. context.error.String("Module not found"); context.error.Ln
  133. END;
  134. END ListCommands;
  135. PROCEDURE List*(context : Commands.Context);
  136. VAR string : ARRAY 32 OF CHAR;
  137. BEGIN
  138. context.arg.SkipWhitespace;
  139. context.arg.String(string);
  140. IF (string = "plugins") THEN ListPlugins(context);
  141. ELSIF (string = "modules") THEN ListModules(context);
  142. ELSIF (string = "commands") THEN ListCommands(context);
  143. ELSE
  144. context.error.String('Usage: SystemTools.List ("plugins"|"modules"|("commands" moduleName))');
  145. context.error.Ln;
  146. END;
  147. END List;
  148. PROCEDURE ModuleIsLoaded(CONST name : Modules.Name) : BOOLEAN;
  149. BEGIN
  150. RETURN Modules.ModuleByName(name) # NIL;
  151. END ModuleIsLoaded;
  152. (** Show all modules that import 'basemodule' (transitively) and are currently loaded. *)
  153. PROCEDURE WhoImports*(context : Commands.Context); (** basemodule ~ *)
  154. VAR name : Modules.Name; root, m : Module;
  155. BEGIN
  156. context.arg.SkipWhitespace;
  157. context.arg.String(name);
  158. IF ModuleIsLoaded(name) THEN
  159. root := CopyModules();
  160. m := root;
  161. WHILE m # NIL DO
  162. IF Imports(root, m, name) THEN
  163. context.out.String(m.m.name); context.out.Ln;
  164. END;
  165. m := m.next;
  166. END;
  167. ELSE
  168. context.error.String("Module "); context.error.String(name); context.error.String(" is not loaded."); context.error.Ln;
  169. END;
  170. END WhoImports;
  171. (** Check whether the specified module is currenlty loaded. *)
  172. PROCEDURE IsLoaded*(context : Commands.Context);
  173. VAR name : Modules.Name;
  174. BEGIN
  175. context.arg.SkipWhitespace;
  176. context.arg.String(name);
  177. context.out.String("Module "); context.out.String(name);
  178. IF ModuleIsLoaded(name) THEN
  179. context.out.String(" is loaded.");
  180. ELSE
  181. context.out.String(" is not loaded.");
  182. END;
  183. context.out.Ln;
  184. END IsLoaded;
  185. (** Load the specified module *)
  186. PROCEDURE Load*(context : Commands.Context); (** modulename ~ *)
  187. VAR name : Modules.Name; module : Modules.Module; msg : ARRAY 256 OF CHAR; res : LONGINT;
  188. BEGIN
  189. context.arg.SkipWhitespace;
  190. context.arg.String(name);
  191. IF ModuleIsLoaded(name) THEN
  192. context.result := Modules.Ok;
  193. context.out.String(name); context.out.String(" is already loaded."); context.out.Ln;
  194. ELSE
  195. module := Modules.ThisModule(name, res, msg);
  196. context.result := res;
  197. IF (res = Modules.Ok) THEN
  198. context.out.String(name); context.out.String(" loaded."); context.out.Ln;
  199. ELSE
  200. context.error.String("Could not load module "); context.error.String(name);
  201. context.error.String(", res: "); context.error.Int(res, 0);
  202. IF (msg # "") THEN
  203. context.error.String(" ("); context.error.String(msg); context.error.String(")");
  204. END;
  205. context.error.Ln;
  206. END;
  207. END;
  208. END Load;
  209. (** Free all modules that import basemodule (transitively). *)
  210. PROCEDURE FreeDownTo*(context : Commands.Context); (** basemodule ~ *)
  211. VAR
  212. modulename : ARRAY 128 OF CHAR;
  213. root, m: Module; res: LONGINT;
  214. timer: Kernel.Timer; msg: ARRAY 64 OF CHAR;
  215. nbrOfUnloadedModules : LONGINT;
  216. BEGIN
  217. context.arg.SkipWhitespace;
  218. context.arg.String(modulename);
  219. LockOberon;
  220. NEW(timer); timer.Sleep(200); (* temporary workaround for race with System.FreeOberon *)
  221. root := CopyModules();
  222. nbrOfUnloadedModules := 0;
  223. m := root;
  224. WHILE m # NIL DO
  225. IF Imports(root, m, modulename) THEN
  226. IF TraceFreeDownTo IN Trace THEN
  227. context.out.String(m.m.name); context.out.Ln;
  228. END;
  229. Modules.FreeModule(m.m.name, res, msg);
  230. IF res # 0 THEN
  231. context.error.String(msg);
  232. ELSE
  233. INC(nbrOfUnloadedModules);
  234. END
  235. END;
  236. m := m.next
  237. END;
  238. UnlockOberon; (* in case Oberon still running *)
  239. context.out.String("Unloaded "); context.out.Int(nbrOfUnloadedModules, 0); context.out.String(" modules."); context.out.Ln;
  240. END FreeDownTo;
  241. (** Unload modules from memory *)
  242. PROCEDURE Free*(context : Commands.Context); (** {modulename} ~ *)
  243. VAR name, msg : ARRAY 64 OF CHAR; res : LONGINT;
  244. BEGIN
  245. WHILE context.arg.GetString(name) DO
  246. IF name # "" THEN
  247. context.out.String("Unloading "); context.out.String(name); context.out.String("... ");
  248. Modules.FreeModule(name, res, msg);
  249. IF res # 0 THEN context.out.String(msg)
  250. ELSE context.out.String("done.")
  251. END;
  252. context.out.Ln;
  253. END;
  254. END;
  255. END Free;
  256. PROCEDURE Kill*(context : Commands.Context); (** pid { pid } ~ *)
  257. VAR process : Objects.Process; pid : LONGINT;
  258. BEGIN {EXCLUSIVE}
  259. WHILE context.arg.GetInteger(pid, FALSE) DO
  260. context.out.Int(pid, 0);
  261. process := ProcessInfo.GetProcess(pid);
  262. IF process # NIL THEN
  263. Objects.TerminateThis(process, FALSE);
  264. context.out.String(" Process killed")
  265. ELSE
  266. context.out.String(" Process not found")
  267. END;
  268. context.out.Ln;
  269. END;
  270. END Kill;
  271. PROCEDURE ShowProcesses*(context : Commands.Context); (** [options] ~ *)
  272. VAR
  273. options : Options.Options;
  274. processes : ARRAY ProcessInfo.MaxNofProcesses OF Objects.Process;
  275. nofProcesses : LONGINT;
  276. string : ARRAY 16 OF CHAR;
  277. i : LONGINT;
  278. BEGIN
  279. NEW(options);
  280. options.Add("s", "sort", Options.String);
  281. IF options.Parse(context.arg, context.error) THEN
  282. ProcessInfo.GetProcesses(processes, nofProcesses);
  283. IF options.GetString("sort", string) THEN
  284. IF (string = "id") THEN
  285. ProcessInfo.Sort(processes, nofProcesses, ProcessInfo.SortByID);
  286. ELSIF (string = "priority") THEN
  287. ProcessInfo.Sort(processes, nofProcesses, ProcessInfo.SortByPriority);
  288. ELSIF (string = "mode") THEN
  289. ProcessInfo.Sort(processes, nofProcesses, ProcessInfo.SortByMode);
  290. ELSE
  291. context.error.String("Sort option "); context.error.String(string);
  292. context.error.String(" unknown... ignore."); context.error.Ln;
  293. END;
  294. END;
  295. FOR i := 0 TO nofProcesses - 1 DO ProcessInfo.ShowProcess(processes[i], context.out); END;
  296. context.out.Int(nofProcesses, 0); context.out.String(" processes"); context.out.Ln;
  297. ProcessInfo.Clear(processes);
  298. END;
  299. END ShowProcesses;
  300. PROCEDURE ShowStacks*(context : Commands.Context);
  301. VAR processes : ARRAY ProcessInfo.MaxNofProcesses OF Objects.Process; nofProcesses, i : LONGINT;
  302. BEGIN
  303. ProcessInfo.GetProcesses(processes, nofProcesses);
  304. FOR i := 0 TO nofProcesses - 1 DO ProcessInfo.ShowStack(processes[i], context.out); END;
  305. ProcessInfo.Clear(processes);
  306. END ShowStacks;
  307. PROCEDURE ShowStack*(context : Commands.Context); (** pid ~ *)
  308. VAR process : Objects.Process; pid : LONGINT;
  309. BEGIN
  310. context.arg.SkipWhitespace;
  311. context.arg.Int(pid, FALSE);
  312. process := ProcessInfo.GetProcess(pid);
  313. IF (process # NIL) THEN
  314. context.out.String("Stack of process ID = "); context.out.Int(pid, 0); context.out.Ln;
  315. ProcessInfo.ShowStack(process, context.out);
  316. ELSE
  317. context.error.String("Process ID = "); context.error.Int(pid, 0); context.error.String(" not found.");
  318. context.error.Ln;
  319. END;
  320. END ShowStack;
  321. (* Changes the extension, Usage: RenameExtension extFrom extTo~ *)
  322. PROCEDURE RenameExtension*(context : Commands.Context);
  323. VAR
  324. enumerator : Files.Enumerator;
  325. oe, ne, temp: ARRAY 16 OF CHAR;
  326. name, file, ext : Files.FileName; flags : SET; time, date, size, res : LONGINT;
  327. BEGIN
  328. context.arg.SkipWhitespace; context.arg.String(oe);
  329. context.arg.SkipWhitespace; context.arg.String(ne);
  330. NEW(enumerator);
  331. temp := "*.";
  332. Strings.Append(temp, oe);
  333. enumerator.Open(temp, {});
  334. temp := ".";
  335. Strings.Append(temp, ne);
  336. context.out.String("-- Renaming Extension --"); context.out.Ln;
  337. WHILE enumerator.HasMoreEntries() DO
  338. IF enumerator.GetEntry(name, flags, time, date, size) THEN
  339. Strings.GetExtension(name, file, ext);
  340. Strings.Append(file, temp);
  341. context.out.String("Renaming: "); context.out.String(name); context.out.String(" to: "); context.out.String(file);
  342. Files.Rename(name, file, res);
  343. IF res = 0 THEN context.out.String(" done"); ELSE context.out.String(" Error!"); END;
  344. context.out.Ln;
  345. END;
  346. END;
  347. context.out.String("-- all done --"); context.out.Ln;
  348. enumerator.Close;
  349. END RenameExtension;
  350. PROCEDURE IsDelimiter(ch : CHAR) : BOOLEAN;
  351. BEGIN
  352. RETURN (ch = " ") OR (ch = CR) OR (ch = LF) OR (ch = TAB) OR (ch = ";") OR (ch = 0X);
  353. END IsDelimiter;
  354. (** Sequentially execute a list of commands .
  355. IMPORTANT: This command is specially handled by command interpreters that support it. It is the only command
  356. in the system for which two tilde characters (only separated by whitespace) are used to delimit the parameter string.
  357. If you change the name of this module or this command, you have to adapt:
  358. - WMTextView.TextView.FindCommandRange *)
  359. PROCEDURE DoCommands*(context : Commands.Context); (** command {"~" command} "~" *)
  360. VAR
  361. newContext : Commands.Context;
  362. commands : Strings.StringArray;
  363. command, parameters, paramString : Strings.String;
  364. temp : Strings.String;
  365. msg : ARRAY 128 OF CHAR;
  366. cur, available, i, j, k, res : LONGINT;
  367. PROCEDURE CreateContext(paramString : Strings.String) : Commands.Context;
  368. VAR c : Commands.Context; arg : Streams.StringReader; dummy : ARRAY 1 OF CHAR;
  369. BEGIN
  370. IF (paramString = NIL) THEN
  371. NEW(arg, 1); dummy := ""; arg.SetRaw(dummy, 0, 1);
  372. ELSE
  373. NEW(arg, LEN(paramString)); arg.SetRaw(paramString^, 0, LEN(paramString));
  374. END;
  375. NEW(c, context.in, arg, context.out, context.error, context.caller);
  376. RETURN c;
  377. END CreateContext;
  378. PROCEDURE Resize(VAR t: Strings.String; len: LONGINT);
  379. VAR new: Strings.String; i: LONGINT;
  380. BEGIN
  381. NEW(new, len);
  382. IF t # NIL THEN
  383. FOR i := 0 TO LEN(t)-1 DO new[i] := t[i] END;
  384. END;
  385. t := new;
  386. END Resize;
  387. BEGIN
  388. cur := context.arg.Available();
  389. IF (cur < 1) THEN RETURN; END;
  390. NEW(temp, cur + 1);
  391. available := 0;
  392. WHILE cur > 0 DO
  393. Resize(temp, available+cur+1);
  394. context.arg.Bytes(temp^, available, cur, i); (* ignore i *)
  395. INC(available, cur);
  396. cur := context.arg.Available();
  397. END;
  398. RemoveComments(temp^, available);
  399. Strings.Truncate (temp^, available);
  400. commands := Strings.Split(temp^, "~");
  401. NEW(command, LEN(temp)); NEW(parameters, LEN(temp));
  402. i := 0;
  403. LOOP
  404. Strings.TrimWS(commands[i]^);
  405. IF (commands[i]^ = "") THEN
  406. (* This means that two tilde characters were only separated by whitespace. One delimits
  407. the last command we have executed and the other one delimits the SystemTools.DoCommands parameters *)
  408. EXIT;
  409. END;
  410. (* extract command *)
  411. j := 0; k := 0;
  412. WHILE ~IsDelimiter(commands[i][j]) DO command[k] := commands[i][j]; INC(k); INC(j); END;
  413. command[k] := 0X;
  414. IF k = 0 THEN EXIT; END; (* end of string *)
  415. (* extract parameters *)
  416. k := 0;
  417. IF (commands[i][j] # "~") & (commands[i][j] # 0X) THEN
  418. INC(j); WHILE (commands[i][j] # 0X) & (commands[i][j] # "~") DO parameters[k] := commands[i][j]; INC(k); INC(j); END;
  419. parameters[k] := 0X;
  420. END;
  421. IF k > 0 THEN
  422. NEW(paramString, k+1);
  423. FOR j := 0 TO k DO paramString[j] := parameters[j]; END;
  424. ELSE
  425. paramString := NIL;
  426. END;
  427. newContext := CreateContext(paramString);
  428. IF TraceCommands IN Trace THEN
  429. context.out.String("SystemTools.DoCommands: Execute command '"); context.out.String(command^);
  430. context.out.String("' parameters: ");
  431. IF (paramString = NIL) THEN context.out.String("None");
  432. ELSE
  433. context.out.String("'"); context.out.String(paramString^); context.out.String("'");
  434. END;
  435. context.out.Ln;
  436. END;
  437. Commands.Activate(command^, newContext, {Commands.Wait}, res, msg);
  438. IF res # Commands.Ok THEN
  439. context.error.String("SystemTools.DoCommands: Command: '");
  440. context.error.String(command^); context.error.String("', parameters: ");
  441. IF paramString = NIL THEN
  442. context.error.String("None");
  443. ELSE
  444. context.error.String("'"); context.error.String(paramString^); context.error.String("'");
  445. END;
  446. context.error.String(" failed: ");
  447. context.error.String(msg); context.error.String(" (res: "); context.error.Int(res, 0); context.error.String(")");
  448. context.error.Ln;
  449. EXIT;
  450. END;
  451. INC(i);
  452. IF i >= LEN(commands) THEN EXIT; END;
  453. END;
  454. END DoCommands;
  455. (** remove Oberon style comments (parantheses and asterisks) from a string of a certain length.
  456. - comments may be nested arbitrarily
  457. - the operation is performed in situ: comments are replaced with whitespace characters
  458. **)
  459. PROCEDURE RemoveComments(VAR string: ARRAY OF CHAR; length: LONGINT);
  460. VAR
  461. pos, level: LONGINT;
  462. BEGIN
  463. level := 0;
  464. pos := 0;
  465. WHILE pos <= length - 1 DO
  466. IF (string[pos] = '(') & (pos + 1 <= length - 1) & (string[pos + 1] = '*') THEN
  467. (* a comment opened -> replace *)
  468. INC(level);
  469. string[pos] := ' '; string[pos + 1] := ' '; INC(pos, 2)
  470. ELSIF (string[pos] = '*') & (pos + 1 <= length - 1) & (string[pos + 1] = ')') THEN
  471. (* a comment is closed -> replace *)
  472. DEC(level);
  473. string[pos] := ' '; string[pos + 1] := ' '; INC(pos, 2)
  474. ELSIF level <= 0 THEN
  475. (* character outside any comment -> leave as is *)
  476. INC(pos)
  477. ELSE
  478. (* character within a comment -> replace *)
  479. string[pos] := ' '; INC(pos)
  480. END
  481. END
  482. END RemoveComments;
  483. PROCEDURE Repeat*(context : Commands.Context); (* nofTimes command [command parameters] ~ *)
  484. VAR
  485. command, msg : ARRAY 128 OF CHAR;
  486. parameterPosition : LONGINT;
  487. nofTimes, res : LONGINT;
  488. BEGIN
  489. nofTimes := 0; command := "";
  490. context.arg.SkipWhitespace; context.arg.Int(nofTimes, FALSE);
  491. context.arg.SkipWhitespace; context.arg.String(command);
  492. IF (nofTimes > 0) & (command # "") THEN
  493. res := Commands.Ok;
  494. parameterPosition := context.arg.Pos();
  495. WHILE (nofTimes > 0) & (res = Commands.Ok) DO
  496. context.arg.SetPos(parameterPosition);
  497. Commands.Activate(command, context, {Commands.Wait}, res, msg);
  498. DEC(nofTimes);
  499. END;
  500. IF (res # Commands.Ok) THEN
  501. context.out.String("Error in command '"); context.out.String(command); context.out.String("', res: ");
  502. context.out.Int(res, 0); context.out.Ln;
  503. END;
  504. END;
  505. END Repeat;
  506. (** Time interval measurement
  507. - start/starth [number]: Set timer <number> to current time (number = 0 if omitted)
  508. - elapsed/elapsedh [number]: Display time difference between timer <number> and the current time (number = 0 if omitted)
  509. - diff/diffh number1 number2: Display time difference between the two timers
  510. *)
  511. PROCEDURE Timer*(context : Commands.Context); (** [ ["start"["h"] [number]] | ["elapsed"["h"] [number]] | ["diff"["h"] number1 number2] ] ~ *)
  512. VAR
  513. string : ARRAY 128 OF CHAR; nbr1, nbr2 : LONGINT;
  514. PROCEDURE ShowUsage;
  515. BEGIN
  516. context.out.String('Usage: SystemTools.Timer [ ["start" [number]] | ["elapsed" [number]] | ["diff" number1 number2] ]');
  517. context.out.Ln;
  518. END ShowUsage;
  519. PROCEDURE Valid(number : LONGINT) : BOOLEAN;
  520. BEGIN
  521. RETURN (0 <= number) & (number < MaxTimers);
  522. END Valid;
  523. BEGIN {EXCLUSIVE}
  524. context.arg.SkipWhitespace; context.arg.String(string);
  525. context.arg.SkipWhitespace; context.arg.Int(nbr1, FALSE);
  526. context.arg.SkipWhitespace; context.arg.Int(nbr2, FALSE);
  527. IF ~Valid(nbr1) THEN ShowUsage; RETURN; END;
  528. IF (string = "start") THEN
  529. timers[nbr1] := Dates.Now();
  530. ELSIF (string = "elapsed") THEN
  531. Strings.ShowTimeDifference(timers[nbr1], Dates.Now(), context.out);
  532. ELSIF Valid(nbr2) THEN
  533. IF (string = "diff") THEN
  534. Strings.ShowTimeDifference(timers[nbr1], timers[nbr2], context.out);
  535. ELSE
  536. ShowUsage;
  537. END;
  538. ELSE
  539. ShowUsage;
  540. END;
  541. END Timer;
  542. (** If no parameter is specified, this command displays the system time on Kernel Log. *)
  543. PROCEDURE Time*(context : Commands.Context); (** ~ *)
  544. VAR datetime : Dates.DateTime; string : ARRAY 32 OF CHAR;
  545. BEGIN
  546. datetime := Dates.Now();
  547. Strings.FormatDateTime(DateTimeFormat, datetime, string);
  548. context.out.String(string); context.out.Ln;
  549. END Time;
  550. (** Display the content of the specified file *)
  551. PROCEDURE ShowFile*(context : Commands.Context); (** filename ~ *)
  552. VAR filename : Files.FileName; file : Files.File; reader : Files.Reader; ch : CHAR;
  553. BEGIN
  554. IF context.arg.GetString(filename) THEN
  555. file := Files.Old(filename);
  556. IF (file # NIL) THEN
  557. Files.OpenReader(reader, file, 0);
  558. REPEAT
  559. reader.Char(ch);
  560. context.out.Char(ch);
  561. UNTIL (reader.res # Streams.Ok);
  562. ELSE
  563. context.error.String("Could not open file "); context.error.String(filename); context.error.Ln;
  564. END;
  565. END;
  566. END ShowFile;
  567. (** Display a string on the context output stream *)
  568. PROCEDURE Show*(context : Commands.Context); (** string ~ *)
  569. VAR ch : CHAR;
  570. BEGIN
  571. REPEAT
  572. ch := context.arg.Get();
  573. IF (ch # 0X) THEN context.out.Char(ch); END;
  574. UNTIL (context.arg.res # Streams.Ok);
  575. END Show;
  576. (** Print carriage return on the context output stream *)
  577. PROCEDURE Ln*(context : Commands.Context); (** ~ *)
  578. BEGIN
  579. context.out.Ln;
  580. END Ln;
  581. (** Block for ms milliseconds *)
  582. PROCEDURE Wait*(context : Commands.Context); (** ms ~ *)
  583. VAR timer : Kernel.Timer; milliseconds : LONGINT;
  584. BEGIN
  585. IF context.arg.GetInteger(milliseconds, FALSE) & (milliseconds > 0) THEN
  586. NEW(timer);
  587. timer.Sleep(milliseconds);
  588. END;
  589. END Wait;
  590. PROCEDURE Reboot*;
  591. BEGIN
  592. Modules.Shutdown(Modules.Reboot);
  593. END Reboot;
  594. PROCEDURE PowerDown*;
  595. BEGIN
  596. Modules.Shutdown(Modules.PowerDown);
  597. END PowerDown;
  598. (** Invoke garbage collector *)
  599. PROCEDURE CollectGarbage*(context : Commands.Context);
  600. BEGIN
  601. context.out.String("Collecting garbage... ");
  602. Kernel.GC;
  603. context.out.String("done."); context.out.Ln;
  604. END CollectGarbage;
  605. PROCEDURE Version*(context : Commands.Context);
  606. BEGIN
  607. context.out.String(Machine.version);context.out.String(" Kernel CRC="); context.out.Hex(SystemVersion.BootCRC, 8); context.out.Ln;
  608. END Version;
  609. END SystemTools.
  610. SystemTools.Free S ~
  611. SystemTools.Kill 57 ~
  612. SystemTools.Time ~
  613. SystemTools.Show Hello World ~
  614. SystemTools.DoCommands
  615. SystemTools.Timer start ~
  616. SystemTools.Show System Time ~ SystemTools.Time ~ SystemTools.Ln ~
  617. SystemTools.Show System Time again ~ SystemTools.Time ~ SystemTools.Ln ~
  618. SystemTools.Wait 2000 ~
  619. SystemTools.Show Time elapsed: ~ SystemTools.Timer elapsed ~ SystemTools.Ln ~
  620. ~
  621. SystemTools.CollectGarbage ~