2
0

InterpreterShell.Mod 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859
  1. MODULE InterpreterShell; (** AUTHOR "be"; PURPOSE "Simple command shell" **)
  2. (**
  3. * Simple echo-based command shell.
  4. *
  5. * History:
  6. *
  7. * 16.05.2006 Added command history, backspace key handling, factored out serial port related code into ShellSerials.Mod (staubesv)
  8. *
  9. *)
  10. IMPORT Modules, Commands, Streams, Pipes, Strings, Files, Interpreter := FoxInterpreter, Diagnostics, Scanner := FoxScanner, SyntaxTree := FoxSyntaxTree, Printout := FoxPrintout, InterpreterSymbols := FoxInterpreterSymbols;
  11. CONST
  12. (* Notify procedure command codes *)
  13. ExitShell* = 1;
  14. Clear* = 2;
  15. Version = "InterpreterShell v1.0";
  16. DefaultAliasFile = "Shell.Alias";
  17. NestingLevelIndicator = ">";
  18. MaxLen = 512;
  19. CmdLen = 64;
  20. ParamLen = MaxLen;
  21. CR = 0DX; LF = 0AX; TAB = 9X;
  22. Backspace = 08X;
  23. Space = 20X;
  24. Delete = 7FX;
  25. Escape = 1BX;
  26. EscapeChar1 = Escape;
  27. EscapeChar2 = '[';
  28. (* Non-ASCII characters *)
  29. CursorUp = 0C1X;
  30. CursorDown = 0C2X;
  31. (* symbols *)
  32. start = {};
  33. inputFile = {0}; (* 01H *)
  34. pipe = {1}; (* 02H *)
  35. outputFile = {2}; (* 04H *)
  36. outputFileAppend = {3}; (* 08H *)
  37. ampersand = {4}; (* 10H *)
  38. whitespace = {5}; (* 20H *)
  39. eoln = {6}; (* 40H *)
  40. char = {7}; (* 80H *)
  41. EndOfParam = pipe + inputFile + outputFile + outputFileAppend + ampersand + eoln;
  42. (* errors *)
  43. ErrFileNotFound = 1;
  44. ErrInvalidFilename = 2;
  45. ErrAlreadyPiped = 3;
  46. ErrPipeAtBeginning = 4;
  47. ErrInvalidCommand = 5;
  48. ErrEolnExpected = 6;
  49. TYPE
  50. CommandsString = POINTER TO RECORD
  51. prev, next: CommandsString;
  52. string: ARRAY MaxLen OF CHAR;
  53. END;
  54. CommandHistory = OBJECT
  55. VAR
  56. first, current: CommandsString;
  57. PROCEDURE GetNextCommand(VAR cmd : ARRAY OF CHAR);
  58. BEGIN
  59. IF first = NIL THEN RETURN END;
  60. IF current = NIL THEN current := first ELSE current := current.next END;
  61. COPY(current.string, cmd);
  62. END GetNextCommand;
  63. PROCEDURE GetPreviousCommand(VAR cmd : ARRAY OF CHAR);
  64. BEGIN
  65. IF first = NIL THEN RETURN END;
  66. IF current = NIL THEN current := first.prev ELSE current := current.prev END;
  67. COPY(current.string, cmd);
  68. END GetPreviousCommand;
  69. PROCEDURE AddCommand(CONST cmd : ARRAY OF CHAR);
  70. VAR command: CommandsString;
  71. BEGIN
  72. IF (cmd = "") THEN (* Don't add to history *) RETURN; END;
  73. command := first;
  74. IF command # NIL THEN
  75. WHILE (command.string # cmd) & (command.next # first) DO command := command.next END;
  76. IF command.string # cmd THEN command := NIL END
  77. END;
  78. IF command # NIL THEN
  79. IF first = command THEN first := command.next END;
  80. command.prev.next := command.next;
  81. command.next.prev := command.prev;
  82. ELSE
  83. NEW (command);
  84. COPY (cmd, command.string);
  85. END;
  86. IF first = NIL THEN
  87. first := command; first.next := first; first.prev := first
  88. ELSE
  89. command.prev := first.prev; command.next := first;
  90. first.prev.next := command; first.prev := command;
  91. END;
  92. current := NIL;
  93. END AddCommand;
  94. PROCEDURE &Init*;
  95. BEGIN first := NIL; current := NIL;
  96. END Init;
  97. END CommandHistory;
  98. TYPE
  99. Command = POINTER TO RECORD
  100. command: ARRAY CmdLen OF CHAR; (* command (e.g. <module>"."<command> *)
  101. parameters: ARRAY ParamLen OF CHAR; (* parameters *)
  102. context: Commands.Context; (* context (in, out & err streams *)
  103. pipe : Pipes.Pipe;
  104. next: Command;
  105. END;
  106. Alias = POINTER TO RECORD
  107. alias,
  108. command: ARRAY CmdLen OF CHAR;
  109. parameters: ARRAY ParamLen OF CHAR;
  110. next: Alias;
  111. END;
  112. NotifyProcedure* = PROCEDURE {DELEGATE} (command : LONGINT);
  113. TYPE
  114. (*
  115. Blocker* = OBJECT (Streams.Writer)
  116. VAR
  117. interpreter: Interpreter.Interpreter; i: LONGINT;
  118. parser: Interpreter.Parser;
  119. reader-: Streams.Reader;
  120. writer-: Streams.Writer;
  121. scanner: Scanner.Scanner;
  122. diagnostics: Diagnostics.StreamDiagnostics;
  123. PROCEDURE & InitBlocker(context: Commands.Context);
  124. VAR pipe: Pipes.Pipe;
  125. BEGIN
  126. TRACE(1);
  127. NEW(diagnostics, context.error);
  128. TRACE(2);
  129. NEW(pipe, 256);
  130. TRACE(3);
  131. NEW(reader, pipe.Receive, 256);
  132. TRACE(4);
  133. NEW(writer, pipe.Send, 256);
  134. END InitBlocker;
  135. PROCEDURE Statements;
  136. VAR statement: SyntaxTree.Statement; statements: SyntaxTree.StatementSequence;
  137. BEGIN
  138. NEW(scanner, "", reader, 0, diagnostics);
  139. TRACE(6);
  140. NEW(parser, scanner, diagnostics);
  141. TRACE(7);
  142. statements := SyntaxTree.NewStatementSequence();
  143. LOOP
  144. WHILE parser.Statement(statements, NIL) DO TRACE("parser statement");
  145. IF parser.Optional(Scanner.Semicolon) THEN END;
  146. END;
  147. TRACE("failure");
  148. END;
  149. END Statements;
  150. BEGIN{ACTIVE}
  151. Statements
  152. END Blocker;
  153. *)
  154. Shell* = OBJECT
  155. VAR
  156. echo, dead, close: BOOLEAN;
  157. context: Commands.Context;
  158. command: ARRAY MaxLen OF CHAR;
  159. res: LONGINT;
  160. nestingLevel : LONGINT; (* how many shells run in this shell? *)
  161. aliases: Alias;
  162. prompt: ARRAY 32 OF CHAR;
  163. (* Connection to the entiry hosting this shell instance *)
  164. upcall : NotifyProcedure;
  165. commandHistory : CommandHistory;
  166. PROCEDURE &Init*(in: Streams.Reader; out, err: Streams.Writer; echo: BOOLEAN; CONST prompt: ARRAY OF CHAR);
  167. BEGIN
  168. ASSERT((in # NIL) & (out # NIL) & (err # NIL));
  169. NEW(context, in, NIL, out, err, SELF);
  170. close := FALSE; dead := FALSE; command[0] := 0X; res := 0; SELF.echo := echo; COPY(prompt, SELF.prompt);
  171. NEW(commandHistory);
  172. END Init;
  173. PROCEDURE Exit*;
  174. BEGIN
  175. close := TRUE;
  176. END Exit;
  177. PROCEDURE DeleteStringFromDisplay(CONST x : ARRAY OF CHAR);
  178. VAR i, len : LONGINT;
  179. BEGIN
  180. len := Strings.Length(x);
  181. FOR i := 0 TO len-1 DO context.out.Char(Backspace); END;
  182. FOR i := 0 TO len-1 DO context.out.Char(Space); END;
  183. FOR i := 0 TO len-1 DO context.out.Char(Backspace); END;
  184. END DeleteStringFromDisplay;
  185. PROCEDURE ReadCommand(w: Streams.Writer);
  186. VAR
  187. ch: CHAR;
  188. currentIndex : LONGINT;
  189. PROCEDURE IsAsciiCharacter(ch : CHAR) : BOOLEAN;
  190. BEGIN
  191. RETURN ORD(ch) <= 127;
  192. END IsAsciiCharacter;
  193. PROCEDURE IsControlCharacter(ch : CHAR) : BOOLEAN;
  194. BEGIN
  195. RETURN ORD(ch) < 32;
  196. END IsControlCharacter;
  197. PROCEDURE HandleEscapeSequence;
  198. BEGIN
  199. ch := context.in.Get();
  200. ch := CHR(ORD(ch)+128);
  201. IF (ch = CursorDown) OR (ch = CursorUp) THEN (* Command History Keys *)
  202. command[currentIndex+1] := 0X;
  203. DeleteStringFromDisplay(command);
  204. IF ch = CursorUp THEN
  205. commandHistory.GetPreviousCommand(command);
  206. ELSE
  207. commandHistory.GetNextCommand(command);
  208. END;
  209. currentIndex := Strings.Length(command)-1;
  210. IF echo & (command # "") THEN context.out.String(command); context.out.Update; END;
  211. ELSE
  212. (* ignore escaped character *)
  213. END;
  214. END HandleEscapeSequence;
  215. BEGIN
  216. command := ""; currentIndex := -1;
  217. LOOP
  218. ch := context.in.Get();
  219. IF IsAsciiCharacter(ch) THEN
  220. IF IsControlCharacter(ch) OR (ch = Delete) THEN
  221. IF (ch = Streams.EOT) OR (context.in.res # Streams.Ok) THEN
  222. EXIT
  223. ELSIF (ch = Backspace) OR (ch = Delete)THEN
  224. IF currentIndex >= 0 THEN (* There is a character at the left of the cursor *)
  225. IF command[currentIndex] = CR THEN
  226. context.out.Char(Backspace); context.out.Char(Space); context.out.Char(Backspace); context.out.Update;
  227. END;
  228. command[currentIndex] := 0X;
  229. DEC(currentIndex);
  230. IF echo THEN
  231. context.out.Char(Backspace); context.out.Char(Space); context.out.Char(Backspace); context.out.Update;
  232. END;
  233. END;
  234. ELSIF (ORD(ch) = 03H) THEN
  235. (* IF runner # NIL THEN AosActive.TerminateThis(runner); END; *)
  236. ELSIF (ch = EscapeChar1) THEN (* Escape sequence *)
  237. IF context.in.Peek() = EscapeChar2 THEN ch := context.in.Get(); HandleEscapeSequence;
  238. ELSIF context.in.Peek() = 0DX THEN (* command *)
  239. ch := context.in.Get();
  240. INC(currentIndex); command[currentIndex] := ch;
  241. EXIT;
  242. ELSIF context.in.Peek () = Escape THEN
  243. command[currentIndex+1] := 0X;
  244. DeleteStringFromDisplay (command); context.out.Update;
  245. ch := context.in.Get (); command := ""; currentIndex := -1;
  246. END;
  247. ELSIF (ch =CR) OR (ch = LF) THEN
  248. INC(currentIndex); command[currentIndex] := ch;
  249. IF (ch = CR) & (context.in.Available() > 0) & (context.in.Peek() = LF) THEN
  250. ch := context.in.Get();
  251. INC(currentIndex); command[currentIndex] := ch;
  252. END;
  253. IF echo THEN context.out.Ln; context.out.Update END;
  254. ELSE
  255. INC(currentIndex);
  256. command[currentIndex] := ch;
  257. IF echo THEN context.out.Char(ch); context.out.Update; END;
  258. END;
  259. ELSE
  260. IF currentIndex <= LEN(command) - 2 (* Always need space for 0X *) THEN
  261. INC(currentIndex);
  262. command[currentIndex] := ch;
  263. IF echo THEN context.out.Char(ch); context.out.Update; END;
  264. END;
  265. END;
  266. ELSE
  267. (* ignore non-ascii characters *)
  268. END;
  269. END;
  270. command[currentIndex+1] := 0X;
  271. IF ch = CR THEN
  272. commandHistory.AddCommand(command);
  273. IF (context.in.Available() > 0) & (context.in.Peek() = LF) THEN ch := context.in.Get() END;
  274. (* IF echo THEN context.out.Ln; context.out.Update END; *)
  275. w.String(command);
  276. END;
  277. END ReadCommand;
  278. (*
  279. PROCEDURE Parse(VAR cmd: Command; VAR wait: BOOLEAN): LONGINT;
  280. VAR sym: SET; pos: LONGINT; c, next: CHAR;
  281. PROCEDURE Init;
  282. BEGIN
  283. pos := 0; c := 0X; next := command[pos]; sym := start; Scan
  284. END Init;
  285. PROCEDURE Scan;
  286. BEGIN
  287. IF (sym # eoln) THEN
  288. c := next; INC(pos); next := command[pos];
  289. CASE c OF
  290. | "<": sym := inputFile
  291. | "|": sym := pipe
  292. | ">": IF (next = ">") THEN sym := outputFileAppend; INC(pos); next := command[pos]; ELSE sym := outputFile END
  293. | "&": sym := ampersand
  294. | " ", 09X: sym := whitespace
  295. | 0X: sym := eoln
  296. ELSE sym := char
  297. END
  298. END
  299. END Scan;
  300. PROCEDURE Match(symbol: SET): BOOLEAN;
  301. BEGIN IF (symbol = sym) THEN Scan; RETURN TRUE ELSE RETURN FALSE END
  302. END Match;
  303. PROCEDURE Skip;
  304. BEGIN
  305. WHILE (sym = whitespace) & (sym # eoln) DO Scan END
  306. END Skip;
  307. PROCEDURE Token(VAR s: ARRAY OF CHAR; cond: SET): BOOLEAN;
  308. VAR i: LONGINT; quote: BOOLEAN;
  309. BEGIN
  310. quote := FALSE;
  311. WHILE (sym * cond = {}) OR (quote & (sym # eoln)) DO
  312. s[i] := c; INC(i); IF (c = '"') OR (c = "'") THEN quote := ~quote END; Scan
  313. END;
  314. s[i] := 0X;
  315. RETURN ~quote
  316. END Token;
  317. PROCEDURE Cmd(): Command;
  318. VAR i: LONGINT; cmd: Command; arg : Streams.StringReader;
  319. BEGIN Skip;
  320. IF (sym = char) THEN
  321. NEW(cmd);
  322. i := 0;
  323. WHILE (sym = char) DO cmd.command[i] := c; INC(i); Scan END; cmd.command[i] := 0X; Skip;
  324. IF (cmd.command # "") THEN
  325. IF (sym * EndOfParam = {}) THEN
  326. IF ~Token(cmd.parameters, EndOfParam) THEN cmd := NIL END
  327. END;
  328. REPEAT UNTIL ~ReplaceAlias(cmd);
  329. NEW(arg, LEN(cmd.parameters)); arg.SetRaw(cmd.parameters, 0, LEN(cmd.parameters));
  330. NEW(cmd.context, context.in, arg, context.out, context.error, SELF);
  331. ELSE cmd := NIL (* invalid command (empty string) *)
  332. END
  333. ELSE cmd := NIL
  334. END;
  335. RETURN cmd
  336. END Cmd;
  337. PROCEDURE CmdLine(VAR command: Command): LONGINT;
  338. VAR cmd, prev: Command; fn: Files.FileName; f: Files.File; fr: Files.Reader; fw: Files.Writer;
  339. r: Streams.Reader; w: Streams.Writer; append, piped: BOOLEAN; s: ARRAY 64 OF CHAR;
  340. BEGIN
  341. cmd := NIL; prev := NIL; command := NIL; res := 0; piped := FALSE;
  342. Init;
  343. REPEAT
  344. cmd := Cmd();
  345. IF (cmd # NIL) THEN
  346. IF (command = NIL) THEN command := cmd END;
  347. IF piped THEN
  348. piped := FALSE;
  349. IF (prev # NIL) THEN
  350. IF (prev.context.out = context.out) & (cmd.context.in = context.in) THEN
  351. NEW(prev.pipe, 1024);
  352. Streams.OpenReader(r, prev.pipe.Receive); Streams.OpenWriter(w, prev.pipe.Send);
  353. prev.context.Init(r, prev.context.arg, w, prev.context.error, SELF);
  354. prev.next := cmd
  355. ELSE res := ErrAlreadyPiped (* already piped *)
  356. END
  357. ELSE res := ErrPipeAtBeginning (* pipe cannot be first symbol *)
  358. END
  359. END;
  360. IF Match(inputFile) THEN (* "<" filename *)
  361. IF (cmd.context.in = context.in) THEN
  362. Skip;
  363. IF Token(fn, -char) & (fn # "") THEN
  364. f := Files.Old(fn);
  365. IF (f # NIL) THEN
  366. Files.OpenReader(fr, f, 0);
  367. cmd.context.Init(fr, cmd.context.arg, cmd.context.out, cmd.context.error, SELF)
  368. ELSE res := ErrFileNotFound (* file not found *)
  369. END
  370. ELSE res := ErrInvalidFilename (* invalid filename *)
  371. END
  372. ELSE res := ErrAlreadyPiped (* error: already piped *)
  373. END
  374. ELSIF Match(pipe) THEN (* "|" command *)
  375. piped := TRUE
  376. END;
  377. prev := cmd
  378. ELSE res := ErrInvalidCommand (* invalid command *)
  379. END
  380. UNTIL (res # 0) OR (cmd = NIL) OR ~piped;
  381. IF (res = 0) THEN
  382. IF (sym * (outputFile+outputFileAppend) # {}) THEN (* ">"[">"] filename *)
  383. append := (sym = outputFileAppend);
  384. Scan; Skip;
  385. IF Token (fn, EndOfParam (*-char *)) & (fn # "") THEN
  386. Skip; f := NIL;
  387. IF append THEN f := Files.Old(fn) END;
  388. IF (f = NIL) THEN f := Files.New(fn); Files.Register(f) END;
  389. IF (f # NIL) THEN
  390. IF append THEN
  391. Files.OpenWriter(fw, f, f.Length());
  392. ELSE
  393. Files.OpenWriter(fw, f, 0);
  394. END;
  395. cmd.context.Init(cmd.context.in, cmd.context.arg, fw, cmd.context.error, SELF);
  396. fw.Update;
  397. ELSE res := ErrFileNotFound (* cannot open output file *)
  398. END
  399. ELSE res := ErrInvalidFilename (* invalid filename *)
  400. END
  401. END
  402. END;
  403. IF (res = 0) THEN
  404. wait := ~Match(ampersand);
  405. WHILE (sym # eoln) & Match(whitespace) DO END;
  406. IF ~Match(eoln) THEN res := ErrEolnExpected END (* end of line expected *)
  407. END;
  408. IF (res # 0) THEN
  409. context.error.String("Error at position "); context.error.Int(pos, 0); context.error.String(": ");
  410. CASE res OF
  411. | ErrFileNotFound: COPY("file not found.", s)
  412. | ErrInvalidFilename: COPY("invalid file name.", s)
  413. | ErrAlreadyPiped: COPY("two input streams.", s)
  414. | ErrPipeAtBeginning: COPY("syntax error.", s)
  415. | ErrInvalidCommand: COPY("invalid command.", s)
  416. | ErrEolnExpected: COPY("too many arguments.", s)
  417. ELSE COPY("unknown error.", s)
  418. END;
  419. context.error.String(s); context.error.Ln; context.error.Update;
  420. command := NIL
  421. END;
  422. RETURN res
  423. END CmdLine;
  424. BEGIN
  425. wait := TRUE;
  426. RETURN CmdLine(cmd)
  427. END Parse;
  428. *)
  429. PROCEDURE ReadAlias(cmd : Command; verbose : BOOLEAN);
  430. VAR s: ARRAY MaxLen OF CHAR; alias, p, q: Alias; i, k: LONGINT; c: CHAR;
  431. BEGIN
  432. IF (cmd.parameters # "") THEN
  433. COPY(cmd.parameters, s);
  434. NEW(alias);
  435. i := 0; c := s[i];
  436. WHILE (c # 0X) & (c # "=") DO alias.alias[i] := c; INC(i); c := s[i] END;
  437. IF (c = "=") THEN
  438. k := 0; INC(i); c := s[i];
  439. WHILE (c # 0X) & (c # " ") & (c # TAB) DO alias.command[k] := c; INC(k); INC(i); c := s[i] END;
  440. END;
  441. IF verbose THEN context.out.String(alias.alias); END;
  442. IF (alias.command # "") THEN (* add an alias *)
  443. WHILE (c # 0X) & ((c = " ") OR (c = TAB)) DO INC(i); c := s[i] END;
  444. k := 0;
  445. WHILE (c # 0X) DO alias.parameters[k] := c; INC(k); INC(i); c := s[i] END;
  446. p := aliases; q := NIL;
  447. WHILE (p # NIL) & (p.alias < alias.alias) DO q := p; p := p.next END;
  448. IF (q = NIL) THEN aliases := alias; aliases.next := p
  449. ELSE q.next := alias; alias.next := p
  450. END;
  451. IF verbose THEN
  452. context.out.String(" = "); context.out.String(alias.command); context.out.Char(" "); context.out.String(alias.parameters);
  453. END;
  454. ELSE (* remove an alias *)
  455. p := aliases; q := NIL;
  456. WHILE (p # NIL) & (p.alias < alias.alias) DO q := p; p := p.next END;
  457. IF (p # NIL) & (p.alias = alias.alias) THEN
  458. IF (q = NIL) THEN aliases := aliases.next
  459. ELSE q.next := p.next
  460. END
  461. END;
  462. IF verbose THEN context.out.String(" removed"); END;
  463. END;
  464. IF verbose THEN context.out.Ln; END;
  465. ELSE (* list aliases *)
  466. p := aliases;
  467. WHILE (p # NIL) DO
  468. IF verbose THEN
  469. context.out.String(p.alias); context.out.String(" = "); context.out.String(p.command); context.out.Char(" ");
  470. context.out.String(p.parameters); context.out.Ln;
  471. END;
  472. p := p.next
  473. END
  474. END
  475. END ReadAlias;
  476. (*
  477. PROCEDURE ReplaceAlias(cmd: Command): BOOLEAN;
  478. VAR a: Alias; d, i: LONGINT;
  479. BEGIN
  480. a := aliases;
  481. WHILE (a # NIL) & (a.alias < cmd.command) DO a := a.next END;
  482. IF (a # NIL) & (a.alias = cmd.command) THEN
  483. COPY(a.command, cmd.command);
  484. IF (a.parameters # "") THEN
  485. IF (cmd.parameters = "") THEN COPY(a.parameters, cmd.parameters)
  486. ELSE
  487. d := Strings.Length(a.parameters) + 1;
  488. FOR i := Strings.Length(cmd.parameters) TO 0 BY -1 DO
  489. cmd.parameters[i+d] := cmd.parameters[i]
  490. END;
  491. FOR i := 0 TO d-2 DO cmd.parameters[i] := a.parameters[i] END;
  492. cmd.parameters[d-1] := " "
  493. END
  494. END;
  495. RETURN TRUE
  496. ELSE
  497. RETURN FALSE
  498. END
  499. END ReplaceAlias;
  500. PROCEDURE ShowHelp;
  501. BEGIN
  502. context.out.String("--- Help --- "); context.out.Ln;
  503. context.out.String("alias: Show list of aliases"); context.out.Ln;
  504. context.out.String("alias 'string'='command': Create alias for command"); context.out.Ln;
  505. context.out.String("alias 'string': Remove alias"); context.out.Ln;
  506. context.out.String("batch: start a new instance of Shell"); context.out.Ln;
  507. context.out.String("clear: Clear screen"); context.out.Ln;
  508. context.out.String("version: Show BimboShell version"); context.out.Ln;
  509. context.out.String("help: Show this help text"); context.out.Ln;
  510. context.out.String("exit: Exit Shell"); context.out.Ln;
  511. context.out.Update;
  512. END ShowHelp;
  513. PROCEDURE Execute(cmd: Command; wait: BOOLEAN; VAR exit: BOOLEAN);
  514. VAR
  515. c: Command; flags: SET;
  516. res : LONGINT; msg: ARRAY MaxLen OF CHAR; oldContext: Commands.Context;
  517. moduleName, commandName : Modules.Name; errormsg : ARRAY 128 OF CHAR;
  518. BEGIN
  519. IF (cmd.command = "alias") THEN
  520. ReadAlias(cmd, TRUE)
  521. ELSIF (cmd.command = "loadalias") THEN
  522. LoadAliasesFromFile(cmd.parameters);
  523. ELSIF (cmd.command = "batch") THEN
  524. context.out.String(Version); context.out.Ln; context.out.Update;
  525. oldContext := context; context := cmd.context;
  526. INC(nestingLevel);
  527. Run;
  528. context := oldContext
  529. ELSIF (cmd.command = "exit") THEN
  530. DEC(nestingLevel);
  531. exit := TRUE
  532. ELSIF (cmd.command = "version") THEN
  533. context.out.String(Version); context.out.Ln; context.out.Update;
  534. ELSIF (cmd.command = "help") THEN
  535. ShowHelp;
  536. ELSIF (cmd.command = "clear") THEN
  537. IF upcall # NIL THEN upcall(Clear); END;
  538. ELSE
  539. c := cmd; res := 0;
  540. WHILE (c # NIL) & (res = 0) DO
  541. IF (c.next = NIL) & wait THEN flags := {Commands.Wait}
  542. ELSE flags := {}
  543. END;
  544. Commands.Split(c.command, moduleName, commandName, res, errormsg);
  545. IF (res # Commands.Ok) THEN
  546. context.error.String(errormsg); context.error.Ln;
  547. ELSE
  548. Commands.Activate(c.command, c.context, flags, res, msg);
  549. (* IF wait & (cmd.pipe # NIL) THEN
  550. KernelLog.String("Pipe closed"); KernelLog.Ln;
  551. cmd.pipe.Close;
  552. END; *)
  553. IF (res # 0) THEN
  554. context.error.String("Error in command: "); context.error.String(cmd.command);
  555. context.error.String(", params: ");
  556. IF c.parameters # "" THEN
  557. context.error.String(c.parameters);
  558. ELSE
  559. context.error.String("None");
  560. END;
  561. context.error.String(", res: "); context.error.Int(res, 0);
  562. context.error.String(" ("); context.error.String(msg); context.error.Char(")");
  563. context.error.Ln
  564. ELSE c := c.next
  565. END;
  566. END;
  567. END
  568. END;
  569. context.out.Update; context.error.Update
  570. END Execute;
  571. *)
  572. TYPE
  573. StringType = POINTER TO ARRAY OF CHAR;
  574. Reader* = OBJECT (Streams.Reader)
  575. VAR length : LONGINT;
  576. data : StringType;
  577. rofs: LONGINT;
  578. PROCEDURE &Init*(initialSize : LONGINT);
  579. BEGIN
  580. IF initialSize < 256 THEN initialSize := 256 END;
  581. NEW(data, initialSize); length := 0; rofs := 0;
  582. InitReader( Receive, initialSize )
  583. END Init;
  584. PROCEDURE Add*(CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT);
  585. VAR i,pos : LONGINT; n: StringType;
  586. BEGIN{EXCLUSIVE}
  587. IF length + len + 1 >= LEN(data) THEN
  588. NEW(n, LEN(data) + len + 1); FOR i := 0 TO length - 1 DO n[i] := data[i] END;
  589. data := n
  590. END;
  591. pos := (rofs + length) MOD LEN(data);
  592. WHILE (len > 0) & (buf[ofs] # 0X) DO
  593. data[pos] := buf[ofs];
  594. pos := (pos+1) MOD LEN(data);
  595. INC(ofs); INC(length); DEC(len)
  596. END;
  597. END Add;
  598. PROCEDURE Receive( VAR buf: ARRAY OF CHAR; ofs, size, min: LONGINT; VAR len, res: LONGINT );
  599. VAR o,pos: LONGINT;
  600. BEGIN{EXCLUSIVE}
  601. AWAIT(length >= min);
  602. pos := rofs;
  603. len := 0;
  604. WHILE (length > 0) & (size >0) DO
  605. buf[ofs] := data[pos];
  606. pos := (pos + 1) MOD LEN(data);
  607. INC(ofs); DEC(length); INC(len); DEC(size);
  608. END;
  609. rofs := pos;
  610. IF ofs < size THEN
  611. buf[ofs] := 0X; (* safety / trace *)
  612. END;
  613. END Receive;
  614. END Reader;
  615. PROCEDURE Run;
  616. VAR cmdList: Command; wait, exit: BOOLEAN; i : LONGINT; interpreter: Interpreter.Interpreter; s: Scanner.StringMaker; w: Streams.Writer; r: Streams.Reader;
  617. scanner: Scanner.Scanner; parser: Interpreter.Parser;
  618. diagnostics: Diagnostics.StreamDiagnostics; seq: SyntaxTree.StatementSequence;
  619. str: Scanner.StringType; len: LONGINT; container: Interpreter.Container; scope: Interpreter.Scope; e: SyntaxTree.Expression; value: Interpreter.Value;
  620. reader: Reader;
  621. runner: OBJECT
  622. VAR
  623. r: Streams.Reader;
  624. scanner: Scanner.Scanner; parser: Interpreter.Parser;
  625. stm: SyntaxTree.Statement;
  626. diagnostics: Diagnostics.Diagnostics;
  627. seq: SyntaxTree.StatementSequence;
  628. interpreter: Interpreter.Interpreter;
  629. container: Interpreter.Container; scope: Interpreter.Scope;
  630. context: Commands.Context;
  631. PROCEDURE &Init(r: Streams.Reader; diag: Diagnostics.Diagnostics; ctxt: Commands.Context);
  632. BEGIN
  633. SELF.r := r; diagnostics := diag; SELF.r := r;
  634. context := ctxt;
  635. END Init;
  636. BEGIN{ACTIVE}
  637. ASSERT(diagnostics # NIL);
  638. NEW(scanner,"", r, 0, diagnostics);
  639. scanner.SetCase(Scanner.Lowercase);
  640. NEW(parser, scanner, diagnostics); (* silent *)
  641. parser.SetLax;
  642. NEW(container);
  643. NEW(scope, Interpreter.global, container);
  644. NEW(interpreter, scope, diagnostics, context);
  645. LOOP
  646. (*diagnostics.Information("interpreter",Diagnostics.Invalid,Diagnostics.Invalid,"start statement");*)
  647. seq := SyntaxTree.NewStatementSequence();
  648. IF parser.Statement(seq, NIL) THEN
  649. (*Printout.Info("executing ", seq);*)
  650. interpreter.StatementSequence(seq);
  651. context.out.Update;
  652. WHILE parser.Optional(Scanner.Escape) OR parser.Optional(Scanner.Semicolon) DO
  653. (*TRACE(parser.Token());*)
  654. END;
  655. IF interpreter.error THEN interpreter.Reset END;
  656. ELSE
  657. diagnostics.Error("",Diagnostics.Invalid, Diagnostics.Invalid, "no statement");
  658. IF ~parser.error THEN
  659. parser.NextSymbol;
  660. END;
  661. (*NEW(scanner, "",r, 0, diagnostics);
  662. NEW(parser, scanner, diagnostics); (* silent *)*)
  663. END;
  664. END;
  665. END;
  666. BEGIN
  667. NEW(s,0);
  668. w := s.GetWriter();
  669. NEW(diagnostics, context.out);
  670. exit := FALSE;
  671. (*NEW(container);
  672. NEW(scope, Interpreter.global, container);
  673. NEW(interpreter, scope, diagnostics, context);
  674. *)
  675. NEW(reader, 1024);
  676. (*NEW(w, reader.Add,1024);*)
  677. NEW(runner, reader, diagnostics, context);
  678. (*seq := parser.StatementSequence(NIL);*)
  679. WHILE ~close & ~exit & (context.in.res = Streams.Ok) DO
  680. IF (prompt # "") THEN
  681. context.out.Ln;
  682. context.out.String(prompt);
  683. FOR i := 0 TO nestingLevel-1 DO
  684. context.out.String(NestingLevelIndicator);
  685. END;
  686. context.out.Update
  687. END;
  688. s.Clear;
  689. ReadCommand(w);w.Char(Escape);w.Ln; w.Update;(*
  690. context.out.Ln; context.out.String("------------");
  691. context.out.Ln; context.out.Update;
  692. *)
  693. str := s.GetString(len);
  694. reader.Add(str^,0,len,TRUE,res);
  695. (*
  696. NEW(scanner, "", s.GetReader(), 0, diagnostics);
  697. NEW(parser, scanner, NIL); (* silent *)
  698. *)
  699. (*
  700. e := parser.Expression();
  701. interpreter.Reset;
  702. IF ~parser.error & parser.Optional(Scanner.EndOfText) THEN
  703. IF interpreter.GetValue(e,value) THEN
  704. value(InterpreterSymbols.Value).WriteValue(context.out); context.out.Update;
  705. END;
  706. ELSE
  707. str := s.GetString(len);
  708. NEW(scanner, "", s.GetReader(), 0, diagnostics);
  709. NEW(parser, scanner, diagnostics);
  710. *)
  711. (*
  712. seq := parser.StatementSequence(NIL);
  713. IF parser.Mandatory(Scanner.EndOfText) THEN
  714. interpreter.StatementSequence(seq);
  715. IF ~interpreter.error THEN
  716. context.out.String("[ok]");
  717. END;
  718. END;
  719. *)
  720. (*END;*)
  721. END;
  722. context.out.Update; context.error.Update
  723. END Run;
  724. PROCEDURE AwaitDeath*;
  725. BEGIN {EXCLUSIVE}
  726. AWAIT(dead)
  727. END AwaitDeath;
  728. PROCEDURE SetUpcall*(proc : NotifyProcedure);
  729. BEGIN
  730. ASSERT((proc # NIL) & (upcall = NIL));
  731. upcall := proc;
  732. END SetUpcall;
  733. PROCEDURE ParseAliases(r : Files.Reader);
  734. VAR cmd : Command;
  735. BEGIN
  736. NEW(cmd);
  737. LOOP
  738. cmd.parameters := "";
  739. r.Ln(cmd.parameters);
  740. IF r.res # Streams.Ok THEN EXIT; END;
  741. ReadAlias(cmd, FALSE);
  742. END;
  743. END ParseAliases;
  744. (* Read aliases from specified file. Returns NIL if file not found or parsing failed. *)
  745. PROCEDURE LoadAliasesFromFile(filename : ARRAY OF CHAR);
  746. VAR in : Files.Reader; f : Files.File;
  747. BEGIN
  748. IF filename = "" THEN COPY(DefaultAliasFile, filename); END;
  749. f := Files.Old(filename);
  750. IF f # NIL THEN
  751. Files.OpenReader(in, f, 0);
  752. IF in # NIL THEN
  753. context.out.String("Loading aliases from "); context.out.String(filename); context.out.String("...");
  754. ParseAliases(in);
  755. context.out.String("done."); context.out.Ln;
  756. END;
  757. ELSE
  758. context.out.String("Loading aliases failed: File "); context.out.String(filename);
  759. context.out.String(" not found."); context.out.Ln;
  760. END;
  761. context.out.Update;
  762. END LoadAliasesFromFile;
  763. BEGIN {ACTIVE, SAFE}
  764. context.out.String(Version); context.out.Ln;
  765. context.out.String("Enter statement sequence in lower case with lax syntax"); context.out.Ln;
  766. context.out.Update;
  767. Run;
  768. IF (upcall # NIL) THEN upcall(ExitShell); END;
  769. BEGIN {EXCLUSIVE} dead := TRUE; END;
  770. END Shell;
  771. END InterpreterShell.
  772. SystemTools.Free WMInterpreterShell InterpreterShell FoxInterpreter~
  773. WMInterpreterShell.Open ~