System.Mod 23 KB

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