SystemTools.Mod 22 KB

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