summaryrefslogtreecommitdiff
path: root/appl/cmd/sh
diff options
context:
space:
mode:
Diffstat (limited to 'appl/cmd/sh')
-rw-r--r--appl/cmd/sh/arg.b181
-rw-r--r--appl/cmd/sh/csv.b244
-rw-r--r--appl/cmd/sh/doc/History14
-rw-r--r--appl/cmd/sh/echo.b96
-rw-r--r--appl/cmd/sh/expr.b281
-rw-r--r--appl/cmd/sh/file2chan.b459
-rw-r--r--appl/cmd/sh/mkfile60
-rw-r--r--appl/cmd/sh/regex.b220
-rw-r--r--appl/cmd/sh/sexprs.b271
-rw-r--r--appl/cmd/sh/sh.b2843
-rw-r--r--appl/cmd/sh/sh.y2592
-rw-r--r--appl/cmd/sh/std.b812
-rw-r--r--appl/cmd/sh/string.b212
-rw-r--r--appl/cmd/sh/test.b96
-rw-r--r--appl/cmd/sh/tk.b426
15 files changed, 8807 insertions, 0 deletions
diff --git a/appl/cmd/sh/arg.b b/appl/cmd/sh/arg.b
new file mode 100644
index 00000000..a0b57b84
--- /dev/null
+++ b/appl/cmd/sh/arg.b
@@ -0,0 +1,181 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("arg: cannot load self: %r"));
+ ctxt.addbuiltin("arg", myself);
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(ctxt: ref Context, nil: Sh,
+ argv: list of ref Listnode, last: int): string
+{
+ case (hd argv).word {
+ "arg" =>
+ return builtin_arg(ctxt, argv, last);
+ }
+ return nil;
+}
+
+runsbuiltin(nil: ref Sh->Context, nil: Sh,
+ nil: list of ref Listnode): list of ref Listnode
+{
+ return nil;
+}
+
+argusage(ctxt: ref Context)
+{
+ ctxt.fail("usage", "usage: arg [opts {command}]... - args");
+}
+
+builtin_arg(ctxt: ref Context, argv: list of ref Listnode, nil: int): string
+{
+ for (args := tl argv; args != nil; args = tl tl args) {
+ if ((hd args).word == "-")
+ break;
+ if ((hd args).cmd != nil && (hd args).word == nil)
+ argusage(ctxt);
+ if (tl args == nil)
+ argusage(ctxt);
+ if ((hd tl args).cmd == nil)
+ argusage(ctxt);
+ }
+ if (args == nil)
+ args = ctxt.get("*");
+ else
+ args = tl args;
+ laststatus := "";
+ ctxt.push();
+ {
+ arg := Arg.init(args);
+ while ((opt := arg.opt()) != 0) {
+ for (argt := tl argv; argt != nil && (hd argt).word != "-"; argt = tl tl argt) {
+ w := (hd argt).word;
+ argcount := 0;
+ for (e := len w - 1; e >= 0; e--) {
+ if (w[e] != '+')
+ break;
+ argcount++;
+ }
+ w = w[0:e+1];
+ if (w == nil)
+ continue;
+ for (i := 0; i < len w; i++)
+ if (w[i] == opt || w[i] == '*')
+ break;
+ if (i < len w) {
+ optstr := ""; optstr[0] = opt;
+ ctxt.setlocal("opt", ref Listnode(nil, optstr) :: nil);
+ args = arg.arg(argcount);
+ if (argcount > 0 && args == nil)
+ ctxt.fail("usage", sys->sprint("option -%c requires %d arguments", opt, argcount));
+ ctxt.setlocal("arg", args);
+ laststatus = ctxt.run(hd tl argt :: nil, 0);
+ break;
+ }
+ }
+ if (argt == nil || (hd argt).word == "-")
+ ctxt.fail("usage", sys->sprint("unknown option -%c", opt));
+ }
+ ctxt.pop();
+ ctxt.set("args", arg.args); # XXX backward compatibility - should go
+ ctxt.set("*", arg.args);
+ return laststatus;
+ }
+ exception e{
+ "fail:*" =>
+ ctxt.pop();
+ if (e[5:] == "break")
+ return laststatus;
+ raise e;
+ }
+}
+
+Arg: adt {
+ args: list of ref Listnode;
+ curropt: string;
+ init: fn(argv: list of ref Listnode): ref Arg;
+ arg: fn(ctxt: self ref Arg, n: int): list of ref Listnode;
+ opt: fn(ctxt: self ref Arg): int;
+};
+
+
+Arg.init(argv: list of ref Listnode): ref Arg
+{
+ return ref Arg(argv, nil);
+}
+
+# get next n option arguments (nil list if not enough arguments found)
+Arg.arg(ctxt: self ref Arg, n: int): list of ref Listnode
+{
+ if (n == 0)
+ return nil;
+
+ args: list of ref Listnode;
+ while (--n >= 0) {
+ if (ctxt.curropt != nil) {
+ args = ref Listnode(nil, ctxt.curropt) :: args;
+ ctxt.curropt = nil;
+ } else if (ctxt.args == nil)
+ return nil;
+ else {
+ args = hd ctxt.args :: args;
+ ctxt.args = tl ctxt.args;
+ }
+ }
+ r: list of ref Listnode;
+ for (; args != nil; args = tl args)
+ r = hd args :: r;
+ return r;
+}
+
+# get next option letter
+# return 0 at end of options
+Arg.opt(ctxt: self ref Arg): int
+{
+ if (ctxt.curropt != "") {
+ opt := ctxt.curropt[0];
+ ctxt.curropt = ctxt.curropt[1:];
+ return opt;
+ }
+
+ if (ctxt.args == nil)
+ return 0;
+
+ nextarg := (hd ctxt.args).word;
+ if (len nextarg < 2 || nextarg[0] != '-')
+ return 0;
+
+ if (nextarg == "--") {
+ ctxt.args = tl ctxt.args;
+ return 0;
+ }
+
+ opt := nextarg[1];
+ if (len nextarg > 2)
+ ctxt.curropt = nextarg[2:];
+ ctxt.args = tl ctxt.args;
+ return opt;
+}
diff --git a/appl/cmd/sh/csv.b b/appl/cmd/sh/csv.b
new file mode 100644
index 00000000..601032d6
--- /dev/null
+++ b/appl/cmd/sh/csv.b
@@ -0,0 +1,244 @@
+implement Shellbuiltin;
+
+# parse/generate comma-separated values.
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+include "bufio.m";
+ bufio: Bufio;
+ Iobuf: import bufio;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("csv: cannot load self: %r"));
+ bufio = load Bufio Bufio->PATH;
+ if (bufio == nil)
+ ctxt.fail("bad module",
+ sys->sprint("csv: cannot load: %s: %r", Bufio->PATH));
+ ctxt.addbuiltin("getcsv", myself);
+ ctxt.addsbuiltin("csv", myself);
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(c: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode, last: int): string
+{
+ return builtin_getcsv(c, cmd, last);
+}
+
+runsbuiltin(c: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode): list of ref Listnode
+{
+ return sbuiltin_csv(c, cmd);
+}
+
+builtin_getcsv(ctxt: ref Context, argv: list of ref Listnode, nil: int) : string
+{
+ n := len argv;
+ if (n != 2 || !iscmd(hd tl argv))
+ builtinusage(ctxt, "getcsv {cmd}");
+ cmd := hd tl argv :: ctxt.get("*");
+ stdin := bufio->fopen(sys->fildes(0), Sys->OREAD);
+ if (stdin == nil)
+ ctxt.fail("bad input", sys->sprint("getcsv: cannot open stdin: %r"));
+ status := "";
+ ctxt.push();
+ for(;;){
+ {
+ for (;;) {
+ line: list of ref Listnode = nil;
+ sl := readcsvline(stdin);
+ if (sl == nil)
+ break;
+ for (; sl != nil; sl = tl sl)
+ line = ref Listnode(nil, hd sl) :: line;
+ ctxt.setlocal("line", line);
+ status = setstatus(ctxt, ctxt.run(cmd, 0));
+ }
+ ctxt.pop();
+ return status;
+ }
+ exception e{
+ "fail:*" =>
+ ctxt.pop();
+ if (loopexcept(e) == BREAK)
+ return status;
+ ctxt.push();
+ }
+ }
+}
+
+CONTINUE, BREAK: con iota;
+loopexcept(ename: string): int
+{
+ case ename[5:] {
+ "break" =>
+ return BREAK;
+ "continue" =>
+ return CONTINUE;
+ * =>
+ raise ename;
+ }
+ return 0;
+}
+
+iscmd(n: ref Listnode): int
+{
+ return n.cmd != nil || (n.word != nil && n.word[0] == '{');
+}
+
+builtinusage(ctxt: ref Context, s: string)
+{
+ ctxt.fail("usage", "usage: " + s);
+}
+
+setstatus(ctxt: ref Context, val: string): string
+{
+ ctxt.setlocal("status", ref Listnode(nil, val) :: nil);
+ return val;
+}
+
+# in csv format, is it possible to distinguish between a line containing
+# one empty field and a line containing no fields at all?
+# what does each one look like?
+readcsvline(iob: ref Iobuf): list of string
+{
+ sl: list of string;
+
+ for(;;) {
+ (s, eof) := readcsvword(iob);
+ if (sl == nil && s == nil && eof)
+ return nil;
+
+ c := Bufio->EOF;
+ if (!eof)
+ c = iob.getc();
+ sl = s :: sl;
+ if (c == '\n' || c == Bufio->EOF)
+ return sl;
+ }
+}
+
+sbuiltin_csv(nil: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ val = tl val;
+ if (val == nil)
+ return nil;
+ s := s2qv(word(hd val));
+ for (val = tl val; val != nil; val = tl val)
+ s += "," + s2qv(word(hd val));
+ return ref Listnode(nil, s) :: nil;
+}
+
+s2qv(s: string): string
+{
+ needquote := 0;
+ needscan := 0;
+ for (i := 0; i < len s; i++) {
+ c := s[i];
+ if (c == '\n' || c == ',')
+ needquote = 1;
+ else if (c == '"') {
+ needquote = 1;
+ needscan = 1;
+ }
+ }
+ if (!needquote)
+ return s;
+ if (!needscan)
+ return "\"" + s + "\"";
+ r := "\"";
+ for (i = 0; i < len s; i++) {
+ c := s[i];
+ if (c == '"')
+ r[len r] = c;
+ r[len r] = c;
+ }
+ r[len r] = '"';
+ return r;
+}
+
+readcsvword(iob: ref Iobuf): (string, int)
+{
+ s := "";
+ case c := iob.getc() {
+ '"' =>
+ for (;;) {
+ case c = iob.getc() {
+ Bufio->EOF =>
+ return (s, 1);
+ '"' =>
+ case c = iob.getc() {
+ '"' =>
+ s[len s] = '"';
+ '\n' or
+ ',' =>
+ iob.ungetc();
+ return (s, 0);
+ Bufio->EOF =>
+ return (s, 1);
+ * =>
+ # illegal
+ iob.ungetc();
+ (t, eof) := readcsvword(iob);
+ return (s + t, eof);
+ }
+ * =>
+ s[len s] = c;
+ }
+ }
+ ',' or
+ '\n' =>
+ iob.ungetc();
+ return (s, 0);
+ Bufio->EOF =>
+ return (nil, 1);
+ * =>
+ s[len s] = c;
+ for (;;) {
+ case c = iob.getc() {
+ ',' or
+ '\n' =>
+ iob.ungetc();
+ return (s, 0);
+ '"' =>
+ # illegal
+ iob.ungetc();
+ (t, eof) := readcsvword(iob);
+ return (s + t, eof);
+ Bufio->EOF =>
+ return (s, 1);
+ * =>
+ s[len s] = c;
+ }
+ }
+ }
+}
+
+word(n: ref Listnode): string
+{
+ if (n.word != nil)
+ return n.word;
+ if (n.cmd != nil)
+ n.word = sh->cmd2string(n.cmd);
+ return n.word;
+}
diff --git a/appl/cmd/sh/doc/History b/appl/cmd/sh/doc/History
new file mode 100644
index 00000000..5a9b4dca
--- /dev/null
+++ b/appl/cmd/sh/doc/History
@@ -0,0 +1,14 @@
+14/11/96 started
+12/12/96 first mostly working version
+13/12/96 fixed bug in builtin_if
+14/12/96 prompt fixed, dup fixed.
+17/1/97 fiddled with shell script perm checking
+16/2/97 converted to yacc grammar
+18/2/97 got pipes and backquotes working, with only minor hacks...
+2/4/00 revamped:
+ single process, single main module; added load builtin; added ${} operator;
+ added eval and std modules
+17/4/00 added '=' and ':=' operators; removed builtin 'set' and 'local'.
+11/6/00 added tuple assignment
+2/3/01 added n-char lookahead in lexer; ':' no longer so special
+15/2/01 store environment variables in standard quoted format.
diff --git a/appl/cmd/sh/echo.b b/appl/cmd/sh/echo.b
new file mode 100644
index 00000000..2fa85def
--- /dev/null
+++ b/appl/cmd/sh/echo.b
@@ -0,0 +1,96 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("echo: cannot load self: %r"));
+ ctxt.addbuiltin("echo", myself);
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(ctxt: ref Context, nil: Sh,
+ argv: list of ref Listnode, last: int): string
+{
+ case (hd argv).word {
+ "echo" =>
+ return builtin_echo(ctxt, argv, last);
+ }
+ return nil;
+}
+
+runsbuiltin(nil: ref Sh->Context, nil: Sh,
+ nil: list of ref Listnode): list of ref Listnode
+{
+ return nil;
+}
+
+argusage(ctxt: ref Context)
+{
+ ctxt.fail("usage", "usage: arg [opts {command}]... - args");
+}
+
+# converted from /appl/cmd/echo.b.
+# should have exactly the same semantics.
+builtin_echo(nil: ref Context, argv: list of ref Listnode, nil: int): string
+{
+ argv = tl argv;
+ nonewline := 0;
+ if (len argv > 0) {
+ w := (hd argv).word;
+ if (w == "-n" || w == "--") {
+ nonewline = (w == "-n");
+ argv = tl argv;
+ }
+ }
+ s := "";
+ if (argv != nil) {
+ s = word(hd argv);
+ for (argv = tl argv; argv != nil; argv = tl argv)
+ s += " " + word(hd argv);
+ }
+ if (nonewline == 0)
+ s[len s] = '\n';
+ {
+ a := array of byte s;
+ if (sys->write(sys->fildes(1), a, len a) != len a) {
+ sys->fprint(sys->fildes(2), "echo: write error: %r\n");
+ return "write error";
+ }
+ return nil;
+ }
+ exception{
+ "write on closed pipe" =>
+ sys->fprint(sys->fildes(2), "echo: write error: write on closed pipe\n");
+ return "write error";
+ }
+}
+
+word(n: ref Listnode): string
+{
+ if (n.word != nil)
+ return n.word;
+ if (n.cmd != nil)
+ n.word = sh->cmd2string(n.cmd);
+ return n.word;
+}
diff --git a/appl/cmd/sh/expr.b b/appl/cmd/sh/expr.b
new file mode 100644
index 00000000..d613dce2
--- /dev/null
+++ b/appl/cmd/sh/expr.b
@@ -0,0 +1,281 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("expr: cannot load self: %r"));
+
+ ctxt.addsbuiltin("expr", myself);
+ ctxt.addbuiltin("ntest", myself);
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+EQ, GT, LT, GE, LE, PLUS, MINUS, DIVIDE, AND, TIMES, MOD,
+OR, XOR, UMINUS, SHL, SHR, NOT, BNOT, NEQ, REP, SEQ: con iota;
+
+runbuiltin(ctxt: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode, nil: int): string
+{
+ case (hd cmd).word {
+ "ntest" =>
+ if (len cmd != 2)
+ ctxt.fail("usage", "usage: ntest n");
+ if (big (hd tl cmd).word == big 0)
+ return "false";
+ }
+ return nil;
+}
+
+runsbuiltin(ctxt: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode): list of ref Listnode
+{
+ # only one sbuiltin: expr.
+ stk: list of big;
+ lastop := -1;
+ lastn := -1;
+ lastname := "";
+ radix: int;
+ (cmd, radix) = opts(ctxt, tl cmd);
+ for (; cmd != nil; cmd = tl cmd) {
+ w := (hd cmd).word;
+ op := -1;
+ nops := 2;
+ case w {
+ "+" =>
+ op = PLUS;
+ "-" =>
+ op = MINUS;
+ "x" or "*" or "×" =>
+ op = TIMES;
+ "/" =>
+ op = DIVIDE;
+ "%" =>
+ op = MOD;
+ "and" =>
+ op = AND;
+ "or" =>
+ op = OR;
+ "xor" =>
+ op = XOR;
+ "_"=>
+ (op, nops) = (UMINUS, 1);
+ "<<" or "shl" =>
+ op = SHL;
+ ">>" or "shr" =>
+ op = SHR;
+ "=" or "==" or "eq" =>
+ op = EQ;
+ "!=" or "neq" =>
+ op = NEQ;
+ ">" or "gt" =>
+ op = GT;
+ "<" or "lt" =>
+ op = LT;
+ ">=" or "ge" =>
+ op = GE;
+ "<=" or "le" =>
+ op = LE;
+ "!" or "not" =>
+ (op, nops) = (NOT, 1);
+ "~" =>
+ (op, nops) = (BNOT, 1);
+ "rep" =>
+ (op, nops) = (REP, 0);
+ "seq" =>
+ (op, nops) = (SEQ, 2);
+ }
+ if (op == -1)
+ stk = makenum(ctxt, w) :: stk;
+ else
+ stk = operator(ctxt, stk, op, nops, lastop, lastn, w, lastname);
+ lastop = op;
+ lastn = nops;
+ lastname = w;
+ }
+ r: list of ref Listnode;
+ for (; stk != nil; stk = tl stk)
+ r = ref Listnode(nil, big2string(hd stk, radix)) :: r;
+ return r;
+}
+
+opts(ctxt: ref Context, cmd: list of ref Listnode): (list of ref Listnode, int)
+{
+ radix := 10;
+ if (cmd == nil)
+ return (nil, 10);
+ w := (hd cmd).word;
+ if (len w < 2)
+ return (cmd, 10);
+ if (w[0] != '-' || (w[1] >= '0' && w[1] <= '9'))
+ return (cmd, 10);
+ if (w[1] != 'r')
+ ctxt.fail("usage", "usage: expr [-r radix] [arg...]");
+ if (len w > 2)
+ w = w[2:];
+ else {
+ if (tl cmd == nil)
+ ctxt.fail("usage", "usage: expr [-r radix] [arg...]");
+ cmd = tl cmd;
+ w = (hd cmd).word;
+ }
+ r := int w;
+ if (r <= 0 || r > 36)
+ ctxt.fail("usage", "expr: invalid radix " + string r);
+ return (tl cmd, int w);
+}
+
+operator(ctxt: ref Context, stk: list of big, op, nops, lastop, lastn: int,
+ opname, lastopname: string): list of big
+{
+ al: list of big;
+ for (i := 0; i < nops; i++) {
+ if (stk == nil)
+ ctxt.fail("empty stack",
+ sys->sprint("expr: empty stack on op '%s'", opname));
+ al = hd stk :: al;
+ stk = tl stk;
+ }
+ return oper(ctxt, al, op, lastop, lastn, lastopname, stk);
+}
+
+# args are in reverse order
+oper(ctxt: ref Context, args: list of big, op, lastop, lastn: int,
+ lastopname: string, stk: list of big): list of big
+{
+ if (op == REP) {
+ if (lastop == -1 || lastop == SEQ || lastn != 2)
+ ctxt.fail("usage", "expr: bad operator for rep");
+ if (stk == nil || tl stk == nil)
+ return stk;
+ while (tl stk != nil)
+ stk = operator(ctxt, stk, lastop, 2, -1, -1, lastopname, nil);
+ return stk;
+ }
+ n2 := big 0;
+ n1 := hd args;
+ if (tl args != nil)
+ n2 = hd tl args;
+ r := big 0;
+ case op {
+ EQ => r = big(n1 == n2);
+ NEQ => r = big(n1 != n2);
+ GT => r = big(n1 > n2);
+ LT => r = big(n1 < n2);
+ GE => r = big(n1 >= n2);
+ LE => r = big(n1 <= n2);
+ PLUS => r = big(n1 + n2);
+ MINUS => r = big(n1 - n2);
+ NOT => r = big(n1 != big 0);
+ DIVIDE =>
+ if (n2 == big 0)
+ ctxt.fail("divide by zero", "expr: division by zero");
+ r = n1 / n2;
+ MOD =>
+ if (n2 == big 0)
+ ctxt.fail("divide by zero", "expr: division by zero");
+ r = n1 % n2;
+ TIMES => r = n1 * n2;
+ AND => r = n1 & n2;
+ OR => r = n1 | n2;
+ XOR => r = n1 ^ n2;
+ UMINUS => r = -n1;
+ BNOT => r = ~n1;
+ SHL => r = n1 << int n2;
+ SHR => r = n1 >> int n2;
+ SEQ => return seq(n1, n2, stk);
+ }
+ return r :: stk;
+}
+
+seq(n1, n2: big, stk: list of big): list of big
+{
+ incr := big 1;
+ if (n2 < n1)
+ incr = big -1;
+ for (; n1 != n2; n1 += incr)
+ stk = n1 :: stk;
+ return n1 :: stk;
+}
+
+makenum(ctxt: ref Context, s: string): big
+{
+ if (s == nil || (s[0] != '-' && (s[0] < '0' || s[0] > '9')))
+ ctxt.fail("usage", sys->sprint("expr: unknown operator '%s'", s));
+
+ t := s;
+ if (neg := s[0] == '-')
+ s = s[1:];
+ radix := 10;
+ for (i := 0; i < len s && i < 3; i++) {
+ if (s[i] == 'r') {
+ radix = int s;
+ s = s[i+1:];
+ break;
+ }
+ }
+ if (radix == 10)
+ return big t;
+ if (radix == 0 || radix > 36)
+ ctxt.fail("usage", "expr: bad number " + t);
+ n := big 0;
+ for (i = 0; i < len s; i++) {
+ if ('0' <= s[i] && s[i] <= '9')
+ n = (n * big radix) + big(s[i] - '0');
+ else if ('a' <= s[i] && s[i] < 'a' + radix - 10)
+ n = (n * big radix) + big(s[i] - 'a' + 10);
+ else if ('A' <= s[i] && s[i] < 'A' + radix - 10)
+ n = (n * big radix) + big(s[i] - 'A' + 10);
+ else
+ break;
+ }
+ if (neg)
+ return -n;
+ return n;
+}
+
+big2string(n: big, radix: int): string
+{
+ if (neg := n < big 0) {
+ n = -n;
+ }
+ s := "";
+ do {
+ c: int;
+ d := int (n % big radix);
+ if (d < 10)
+ c = '0' + d;
+ else
+ c = 'a' + d - 10;
+ s[len s] = c;
+ n /= big radix;
+ } while (n > big 0);
+ t := s;
+ for (i := len s - 1; i >= 0; i--)
+ t[len s - 1 - i] = s[i];
+ if (radix != 10)
+ t = string radix + "r" + t;
+ if (neg)
+ return "-" + t;
+ return t;
+}
diff --git a/appl/cmd/sh/file2chan.b b/appl/cmd/sh/file2chan.b
new file mode 100644
index 00000000..a54c9965
--- /dev/null
+++ b/appl/cmd/sh/file2chan.b
@@ -0,0 +1,459 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "lock.m";
+ lock: Lock;
+ Semaphore: import lock;
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+
+Tag: adt {
+ tagid, blocked: int;
+ offset, fid: int;
+ pick {
+ Read =>
+ count: int;
+ rc: chan of (array of byte, string);
+ Write =>
+ data: array of byte;
+ wc: chan of (int, string);
+ }
+};
+
+taglock: ref Lock->Semaphore;
+maxtagid := 1;
+tags := array[16] of list of ref Tag;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("file2chan: cannot load self: %r"));
+
+ lock = load Lock Lock->PATH;
+ if (lock == nil) ctxt.fail("bad module", sys->sprint("file2chan: cannot load %s: %r", Lock->PATH));
+ lock->init();
+
+ taglock = Semaphore.new();
+ if (taglock == nil)
+ ctxt.fail("no lock", "file2chan: cannot make lock");
+
+
+ ctxt.addbuiltin("file2chan", myself);
+ ctxt.addbuiltin("rblock", myself);
+ ctxt.addbuiltin("rread", myself);
+ ctxt.addbuiltin("rreadone", myself);
+ ctxt.addbuiltin("rwrite", myself);
+ ctxt.addbuiltin("rerror", myself);
+ ctxt.addbuiltin("fetchwdata", myself);
+ ctxt.addbuiltin("putrdata", myself);
+ ctxt.addsbuiltin("rget", myself);
+
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(ctxt: ref Context, nil: Sh,
+ cmd: list of ref Listnode, nil: int): string
+{
+ case (hd cmd).word {
+ "file2chan" => return builtin_file2chan(ctxt, cmd);
+ "rblock" => return builtin_rblock(ctxt, cmd);
+ "rread" => return builtin_rread(ctxt, cmd, 0);
+ "rreadone" => return builtin_rread(ctxt, cmd, 1);
+ "rwrite" => return builtin_rwrite(ctxt, cmd);
+ "rerror" => return builtin_rerror(ctxt, cmd);
+ "fetchwdata" => return builtin_fetchwdata(ctxt, cmd);
+ "putrdata" => return builtin_putrdata(ctxt, cmd);
+ }
+ return nil;
+}
+
+runsbuiltin(ctxt: ref Context, nil: Sh,
+ argv: list of ref Listnode): list of ref Listnode
+{
+ # could add ${rtags} to retrieve list of currently outstanding tags
+ case (hd argv).word {
+ "rget" => return sbuiltin_rget(ctxt, argv);
+ }
+ return nil;
+}
+
+builtin_file2chan(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ rcmd, wcmd, ccmd: ref Listnode;
+ path: string;
+
+ n := len argv;
+ if (n < 4 || n > 5)
+ ctxt.fail("usage", "usage: file2chan file {readcmd} {writecmd} [ {closecmd} ]");
+
+ (path, argv) = ((hd tl argv).word, tl tl argv);
+ (rcmd, argv) = (hd argv, tl argv);
+ (wcmd, argv) = (hd argv, tl argv);
+ if (argv != nil)
+ ccmd = hd argv;
+ if (path == nil || !iscmd(rcmd) || !iscmd(wcmd) || (ccmd != nil && !iscmd(ccmd)))
+ ctxt.fail("usage", "usage: file2chan file {readcmd} {writecmd} [ {closecmd} ]");
+
+ (dir, f) := pathsplit(path);
+ if (sys->bind("#s", dir, Sys->MBEFORE|Sys->MCREATE) == -1) {
+ reporterror(ctxt, sys->sprint("file2chan: cannot bind #s: %r"));
+ return "no #s";
+ }
+ fio := sys->file2chan(dir, f);
+ if (fio == nil) {
+ reporterror(ctxt, sys->sprint("file2chan: cannot make %s: %r", path));
+ return "cannot make chan";
+ }
+ sync := chan of int;
+ spawn srv(sync, ctxt, fio, rcmd, wcmd, ccmd);
+ apid := <-sync;
+ ctxt.set("apid", ref Listnode(nil, string apid) :: nil);
+ if (ctxt.options() & ctxt.INTERACTIVE)
+ sys->fprint(sys->fildes(2), "%d\n", apid);
+ return nil;
+}
+
+srv(sync: chan of int, ctxt: ref Context,
+ fio: ref Sys->FileIO, rcmd, wcmd, ccmd: ref Listnode)
+{
+ ctxt = ctxt.copy(1);
+ sync <-= sys->pctl(0, nil);
+ for (;;) {
+ fid, offset, count: int;
+ rc: Sys->Rread;
+ wc: Sys->Rwrite;
+ d: array of byte;
+ t: ref Tag = nil;
+ cmd: ref Listnode = nil;
+ alt {
+ (offset, count, fid, rc) = <-fio.read =>
+ if (rc != nil) {
+ t = ref Tag.Read(0, 0, offset, fid, count, rc);
+ cmd = rcmd;
+ } else
+ continue; # we get a close on both read and write...
+ (offset, d, fid, wc) = <-fio.write =>
+ if (wc != nil) {
+ t = ref Tag.Write(0, 0, offset, fid, d, wc);
+ cmd = wcmd;
+ }
+ }
+ if (t != nil) {
+ addtag(t);
+ ctxt.setlocal("tag", ref Listnode(nil, string t.tagid) :: nil);
+ ctxt.run(cmd :: nil, 0);
+ taglock.obtain();
+ # make a default reply if it hasn't been deliberately blocked.
+ del := 0;
+ if (t.tagid >= 0 && !t.blocked) {
+ pick mt := t {
+ Read =>
+ rreply(mt.rc, nil, "invalid read");
+ Write =>
+ wreply(mt.wc, len mt.data, nil);
+ }
+ del = 1;
+ }
+ taglock.release();
+ if (del)
+ deltag(t.tagid);
+ ctxt.setlocal("tag", nil);
+ } else if (ccmd != nil) {
+ t = ref Tag.Read(0, 0, -1, fid, -1, nil);
+ addtag(t);
+ ctxt.setlocal("tag", ref Listnode(nil, string t.tagid) :: nil);
+ ctxt.run(ccmd :: nil, 0);
+ deltag(t.tagid);
+ ctxt.setlocal("tag", nil);
+ }
+ }
+}
+
+builtin_rread(ctxt: ref Context, argv: list of ref Listnode, one: int): string
+{
+ n := len argv;
+ if (n < 2 || n > 3)
+ ctxt.fail("usage", "usage: "+(hd argv).word+" [tag] data");
+ argv = tl argv;
+
+ t := envgettag(ctxt, argv, n == 3);
+ if (t == nil)
+ ctxt.fail("bad tag", "rread: cannot find tag");
+ if (n == 3)
+ argv = tl argv;
+ mt := etr(ctxt, "rread", t);
+ arg := word(hd argv);
+ d := array of byte arg;
+ if (one) {
+ if (mt.offset >= len d)
+ d = nil;
+ else
+ d = d[mt.offset:];
+ }
+ if (len d > mt.count)
+ d = d[0:mt.count];
+ rreply(mt.rc, d, nil);
+ deltag(t.tagid);
+ return nil;
+}
+
+builtin_rwrite(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ n := len argv;
+ if (n > 3)
+ ctxt.fail("usage", "usage: rwrite [tag [count]]");
+ t := envgettag(ctxt, tl argv, n > 1);
+ if (t == nil)
+ ctxt.fail("bad tag", "rwrite: cannot find tag");
+
+ mt := etw(ctxt, "rwrite", t);
+ count := len mt.data;
+ if (n == 3) {
+ arg := word(hd tl argv);
+ if (!isnum(arg))
+ ctxt.fail("usage", "usage: freply [tag [count]]");
+ count = int arg;
+ }
+ wreply(mt.wc, count, nil);
+ deltag(t.tagid);
+ return nil;
+}
+
+builtin_rblock(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ argv = tl argv;
+ if (len argv > 1)
+ ctxt.fail("usage", "usage: rblock [tag]");
+ t := envgettag(ctxt, argv, argv != nil);
+ if (t == nil)
+ ctxt.fail("bad tag", "rblock: cannot find tag");
+ t.blocked = 1;
+ return nil;
+}
+
+sbuiltin_rget(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ n := len argv;
+ if (n < 2 || n > 3)
+ ctxt.fail("usage", "usage: rget (data|count|offset|fid) [tag]");
+ argv = tl argv;
+ t := envgettag(ctxt, tl argv, tl argv != nil);
+ if (t == nil)
+ ctxt.fail("bad tag", "rget: cannot find tag");
+ s := "";
+ case (hd argv).word {
+ "data" =>
+ s = string etw(ctxt, "rget", t).data;
+ "count" =>
+ s = string etr(ctxt, "rget", t).count;
+ "offset" =>
+ s = string t.offset;
+ "fid" =>
+ s = string t.fid;
+ * =>
+ ctxt.fail("usage", "usage: rget (data|count|offset|fid) [tag]");
+ }
+
+ return ref Listnode(nil, s) :: nil;
+}
+
+builtin_fetchwdata(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ argv = tl argv;
+ if (len argv > 1)
+ ctxt.fail("usage", "usage: fetchwdata [tag]");
+ t := envgettag(ctxt, argv, argv != nil);
+ if (t == nil)
+ ctxt.fail("bad tag", "fetchwdata: cannot find tag");
+ d := etw(ctxt, "fetchwdata", t).data;
+ sys->write(sys->fildes(1), d, len d);
+ return nil;
+}
+
+builtin_putrdata(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ argv = tl argv;
+ if (len argv > 1)
+ ctxt.fail("usage", "usage: putrdata [tag]");
+ t := envgettag(ctxt, argv, argv != nil);
+ if (t == nil)
+ ctxt.fail("bad tag", "putrdata: cannot find tag");
+ mt := etr(ctxt, "putrdata", t);
+ buf := array[mt.count] of byte;
+ n := 0;
+ fd := sys->fildes(0);
+ while (n < mt.count) {
+ nr := sys->read(fd, buf[n:mt.count], mt.count - n);
+ if (nr <= 0)
+ break;
+ n += nr;
+ }
+
+ rreply(mt.rc, buf[0:n], nil);
+ deltag(t.tagid);
+ return nil;
+}
+
+builtin_rerror(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ # usage: ferror [tag] error
+ n := len argv;
+ if (n < 2 || n > 3)
+ ctxt.fail("usage", "usage: ferror [tag] error");
+ t := envgettag(ctxt, tl argv, n == 3);
+ if (t == nil)
+ ctxt.fail("bad tag", "rerror: cannot find tag");
+ if (n == 3)
+ argv = tl argv;
+ err := word(hd tl argv);
+ pick mt := t {
+ Read =>
+ rreply(mt.rc, nil, err);
+ Write =>
+ wreply(mt.wc, 0, err);
+ }
+ deltag(t.tagid);
+ return nil;
+}
+
+envgettag(ctxt: ref Context, args: list of ref Listnode, useargs: int): ref Tag
+{
+ tagid: int;
+ if (useargs)
+ tagid = int (hd args).word;
+ else {
+ args = ctxt.get("tag");
+ if (args == nil || tl args != nil)
+ return nil;
+ tagid = int (hd args).word;
+ }
+ return gettag(tagid);
+}
+
+etw(ctxt: ref Context, cmd: string, t: ref Tag): ref Tag.Write
+{
+ pick mt := t {
+ Write => return mt;
+ }
+ ctxt.fail("bad tag", cmd + ": inappropriate tag id");
+ return nil;
+}
+
+etr(ctxt: ref Context, cmd: string, t: ref Tag): ref Tag.Read
+{
+ pick mt := t {
+ Read => return mt;
+ }
+ ctxt.fail("bad tag", cmd + ": inappropriate tag id");
+ return nil;
+}
+
+wreply(wc: chan of (int, string), count: int, err: string)
+{
+ alt {
+ wc <-= (count, err) => ;
+ * => ;
+ }
+}
+
+rreply(rc: chan of (array of byte, string), d: array of byte, err: string)
+{
+ alt {
+ rc <-= (d, err) => ;
+ * => ;
+ }
+}
+
+word(n: ref Listnode): string
+{
+ if (n.word != nil)
+ return n.word;
+ if (n.cmd != nil)
+ n.word = sh->cmd2string(n.cmd);
+ return n.word;
+}
+
+isnum(s: string): int
+{
+ for (i := 0; i < len s; i++)
+ if (s[i] > '9' || s[i] < '0')
+ return 0;
+ return 1;
+}
+
+iscmd(n: ref Listnode): int
+{
+ return n.cmd != nil || (n.word != nil && n.word[0] == '}');
+}
+
+addtag(t: ref Tag)
+{
+ taglock.obtain();
+ t.tagid = maxtagid++;
+ slot := t.tagid % len tags;
+ tags[slot] = t :: tags[slot];
+ taglock.release();
+}
+
+deltag(tagid: int)
+{
+ taglock.obtain();
+ slot := tagid % len tags;
+ nwl: list of ref Tag;
+ for (wl := tags[slot]; wl != nil; wl = tl wl)
+ if ((hd wl).tagid != tagid)
+ nwl = hd wl :: nwl;
+ else
+ (hd wl).tagid = -1;
+ tags[slot] = nwl;
+ taglock.release();
+}
+
+gettag(tagid: int): ref Tag
+{
+ slot := tagid % len tags;
+ for (wl := tags[slot]; wl != nil; wl = tl wl)
+ if ((hd wl).tagid == tagid)
+ return hd wl;
+ return nil;
+}
+
+pathsplit(p: string): (string, string)
+{
+ for (i := len p - 1; i >= 0; i--)
+ if (p[i] != '/')
+ break;
+ if (i < 0)
+ return (p, nil);
+ p = p[0:i+1];
+ for (i = len p - 1; i >=0; i--)
+ if (p[i] == '/')
+ break;
+ if (i < 0)
+ return (".", p);
+ return (p[0:i+1], p[i+1:]);
+}
+
+reporterror(ctxt: ref Context, err: string)
+{
+ if (ctxt.options() & ctxt.VERBOSE)
+ sys->fprint(sys->fildes(2), "%s\n", err);
+}
diff --git a/appl/cmd/sh/mkfile b/appl/cmd/sh/mkfile
new file mode 100644
index 00000000..383c5ed9
--- /dev/null
+++ b/appl/cmd/sh/mkfile
@@ -0,0 +1,60 @@
+<../../../mkconfig
+
+TARG=sh.dis\
+ arg.dis\
+ expr.dis\
+ file2chan.dis\
+ regex.dis\
+ sexprs.dis\
+ std.dis\
+ string.dis\
+ tk.dis\
+ echo.dis\
+ csv.dis\
+ test.dis\
+
+INS= $ROOT/dis/sh.dis\
+ $ROOT/dis/sh/arg.dis\
+ $ROOT/dis/sh/expr.dis\
+ $ROOT/dis/sh/regex.dis\
+ $ROOT/dis/sh/std.dis\
+ $ROOT/dis/sh/string.dis\
+# $ROOT/dis/sh/tk.dis\
+ $ROOT/dis/sh/echo.dis\
+ $ROOT/dis/sh/csv.dis\
+ $ROOT/dis/sh/test.dis\
+
+SYSMODULES=\
+ bufio.m\
+ draw.m\
+ env.m\
+ filepat.m\
+ lock.m\
+ sexprs.m\
+ sh.m\
+ string.m\
+ sys.m\
+ tk.m\
+ tkclient.m\
+
+DISBIN=$ROOT/dis/sh
+
+<$ROOT/mkfiles/mkdis
+
+all:V: $TARG
+
+install:V: $INS
+
+nuke:V: clean
+ rm -f $INS
+
+clean:V:
+ rm -f *.dis *.sbl
+
+uninstall:V:
+ rm -f $INS
+
+$ROOT/dis/sh.dis: sh.dis
+ rm -f $ROOT/dis/sh.dis && cp sh.dis $ROOT/dis/sh.dis
+
+%.dis: ${SYSMODULES:%=$MODDIR/%}
diff --git a/appl/cmd/sh/regex.b b/appl/cmd/sh/regex.b
new file mode 100644
index 00000000..e761a8ba
--- /dev/null
+++ b/appl/cmd/sh/regex.b
@@ -0,0 +1,220 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+include "regex.m";
+ regex: Regex;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("regex: cannot load self: %r"));
+ regex = load Regex Regex->PATH;
+ if (regex == nil)
+ ctxt.fail("bad module",
+ sys->sprint("regex: cannot load %s: %r", Regex->PATH));
+ ctxt.addbuiltin("match", myself);
+ ctxt.addsbuiltin("re", myself);
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(ctxt: ref Context, nil: Sh,
+ argv: list of ref Listnode, nil: int): string
+{
+ case (hd argv).word {
+ "match" =>
+ return builtin_match(ctxt, argv);
+ }
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+runsbuiltin(ctxt: ref Context, nil: Sh,
+ argv: list of ref Listnode): list of ref Listnode
+{
+ name := (hd argv).word;
+ case name {
+ "re" =>
+ return sbuiltin_re(ctxt, argv);
+ }
+ return nil;
+}
+
+sbuiltin_re(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ if (tl argv == nil)
+ ctxt.fail("usage", "usage: re (g|v|s|sg|m|mg|M) arg...");
+ argv = tl argv;
+ w := (hd argv).word;
+ case w {
+ "g" or
+ "v" =>
+ return sbuiltin_sel(ctxt, argv, w == "v");
+ "s" or
+ "sg" =>
+ return sbuiltin_sub(ctxt, argv, w == "sg");
+ "m" =>
+ return sbuiltin_match(ctxt, argv, 0);
+ "mg" =>
+ return sbuiltin_gmatch(ctxt, argv);
+ "M" =>
+ return sbuiltin_match(ctxt, argv, 1);
+ * =>
+ ctxt.fail("usage", "usage: re (g|v|s|sg|m|mg|M) arg...");
+ return nil;
+ }
+}
+
+sbuiltin_match(ctxt: ref Context, argv: list of ref Listnode, aflag: int): list of ref Listnode
+{
+ if (len argv != 3)
+ ctxt.fail("usage", "usage: re " + (hd argv).word + " arg");
+ argv = tl argv;
+ re := getregex(ctxt, word(hd argv), aflag);
+ w := word(hd tl argv);
+ a := regex->execute(re, w);
+ if (a == nil)
+ return nil;
+ ret: list of ref Listnode;
+ for (i := len a - 1; i >= 0; i--)
+ ret = ref Listnode(nil, elem(a, i, w)) :: ret;
+ return ret;
+}
+
+sbuiltin_gmatch(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ if (len argv != 3)
+ ctxt.fail("usage", "usage: re mg arg");
+ argv = tl argv;
+ re := getregex(ctxt, word(hd argv), 0);
+ w := word(hd tl argv);
+ ret, nret: list of ref Listnode;
+ beg := 0;
+ while ((a := regex->executese(re, w, (beg, len w), beg == 0, 1)) != nil) {
+ (s, e) := a[0];
+ ret = ref Listnode(nil, w[s:e]) :: ret;
+ if (s == e)
+ break;
+ beg = e;
+ }
+ for (; ret != nil; ret = tl ret)
+ nret = hd ret :: nret;
+ return nret;
+}
+
+sbuiltin_sel(ctxt: ref Context, argv: list of ref Listnode, vflag: int): list of ref Listnode
+{
+ cmd := (hd argv).word;
+ argv = tl argv;
+ if (argv == nil)
+ ctxt.fail("usage", "usage: " + cmd + " regex [arg...]");
+ re := getregex(ctxt, word(hd argv), 0);
+ ret, nret: list of ref Listnode;
+ for (argv = tl argv; argv != nil; argv = tl argv)
+ if (vflag ^ (regex->execute(re, word(hd argv)) != nil))
+ ret = hd argv :: ret;
+ for (; ret != nil; ret = tl ret)
+ nret = hd ret :: nret;
+ return nret;
+}
+
+sbuiltin_sub(ctxt: ref Context, argv: list of ref Listnode, gflag: int): list of ref Listnode
+{
+ cmd := (hd argv).word;
+ argv = tl argv;
+ if (argv == nil || tl argv == nil)
+ ctxt.fail("usage", "usage: " + cmd + " regex subs [arg...]");
+ re := getregex(ctxt, word(hd argv), 1);
+ subs := word(hd tl argv);
+ ret, nret: list of ref Listnode;
+ for (argv = tl tl argv; argv != nil; argv = tl argv)
+ ret = ref Listnode(nil, substitute(word(hd argv), re, subs, gflag).t1) :: ret;
+ for (; ret != nil; ret = tl ret)
+ nret = hd ret :: nret;
+ return nret;
+}
+
+builtin_match(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ if (tl argv == nil)
+ ctxt.fail("usage", "usage: match regexp [arg...]");
+ re := getregex(ctxt, word(hd tl argv), 0);
+ for (argv = tl tl argv; argv != nil; argv = tl argv)
+ if (regex->execute(re, word(hd argv)) == nil)
+ return "no match";
+ return nil;
+}
+
+substitute(w: string, re: Regex->Re, subs: string, gflag: int): (int, string)
+{
+ matched := 0;
+ s := "";
+ beg := 0;
+ do {
+ a := regex->executese(re, w, (beg, len w), beg == 0, 1);
+ if (a == nil)
+ break;
+ matched = 1;
+ s += w[beg:a[0].t0];
+ for (i := 0; i < len subs; i++) {
+ if (subs[i] != '\\' || i == len subs - 1)
+ s[len s] = subs[i];
+ else {
+ c := subs[++i];
+ if (c < '0' || c > '9')
+ s[len s] = c;
+ else
+ s += elem(a, c - '0', w);
+ }
+ }
+ beg = a[0].t1;
+ if (a[0].t0 == a[0].t1)
+ break;
+ } while (gflag && beg < len w);
+ return (matched, s + w[beg:]);
+}
+
+elem(a: array of (int, int), i: int, w: string): string
+{
+ if (i < 0 || i >= len a)
+ return nil; # XXX could raise failure here. (invalid backslash escape)
+ (s, e) := a[i];
+ if (s == -1)
+ return nil;
+ return w[s:e];
+}
+
+# XXX could do regex caching here if it was worth it.
+getregex(ctxt: ref Context, res: string, flag: int): Regex->Re
+{
+ (re, err) := regex->compile(res, flag);
+ if (re == nil)
+ ctxt.fail("bad regex", "regex: bad regex \"" + res + "\": " + err);
+ return re;
+}
+
+word(n: ref Listnode): string
+{
+ if (n.word != nil)
+ return n.word;
+ if (n.cmd != nil)
+ n.word = sh->cmd2string(n.cmd);
+ return n.word;
+}
diff --git a/appl/cmd/sh/sexprs.b b/appl/cmd/sh/sexprs.b
new file mode 100644
index 00000000..1908078a
--- /dev/null
+++ b/appl/cmd/sh/sexprs.b
@@ -0,0 +1,271 @@
+implement Shellbuiltin;
+
+# parse/generate sexprs.
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+include "bufio.m";
+ bufio: Bufio;
+ Iobuf: import bufio;
+include "sexprs.m";
+ sexprs: Sexprs;
+ Sexp: import sexprs;
+
+# getsexprs cmd
+# islist val
+# ${els se}
+# ${text se}
+# ${textels se}
+
+# ${mktext val}
+# ${mklist [val...]}
+# ${mktextlist [val...]}
+
+Maxerrs: con 10;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("sexpr: cannot load self: %r"));
+ bufio = load Bufio Bufio->PATH;
+ if (bufio == nil)
+ ctxt.fail("bad module", sys->sprint("sexpr: cannot load: %s: %r", Bufio->PATH));
+ sexprs = load Sexprs Sexprs->PATH;
+ if(sexprs == nil)
+ ctxt.fail("bad module", sys->sprint("sexpr: cannot load: %s: %r", Sexprs->PATH));
+ sexprs->init();
+ ctxt.addbuiltin("getsexprs", myself);
+ ctxt.addbuiltin("islist", myself);
+ ctxt.addsbuiltin("els", myself);
+ ctxt.addsbuiltin("text", myself);
+ ctxt.addsbuiltin("b64", myself);
+ ctxt.addsbuiltin("textels", myself);
+ ctxt.addsbuiltin("mktext", myself);
+ ctxt.addsbuiltin("mklist", myself);
+ ctxt.addsbuiltin("mktextlist", myself);
+
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(c: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode, nil: int): string
+{
+ case (hd cmd).word {
+ "getsexprs" =>
+ return builtin_getsexprs(c, tl cmd);
+ "islist" =>
+ return builtin_islist(c, tl cmd);
+ }
+ return nil;
+}
+
+runsbuiltin(c: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode): list of ref Listnode
+{
+ case (hd cmd).word {
+ "els" =>
+ return sbuiltin_els(c, tl cmd);
+ "text" =>
+ return sbuiltin_text(c, tl cmd);
+ "b64" =>
+ return sbuiltin_b64(c, tl cmd);
+ "textels" =>
+ return sbuiltin_textels(c, tl cmd);
+ "mktext" =>
+ return sbuiltin_mktext(c, tl cmd);
+ "mklist" =>
+ return sbuiltin_mklist(c, tl cmd);
+ "mktextlist" =>
+ return sbuiltin_mktextlist(c, tl cmd);
+ }
+ return nil;
+}
+
+builtin_getsexprs(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ n := len argv;
+ if (n != 1 || !iscmd(hd argv))
+ builtinusage(ctxt, "getsexprs {cmd}");
+ cmd := hd argv :: ctxt.get("*");
+ stdin := bufio->fopen(sys->fildes(0), Sys->OREAD);
+ if (stdin == nil)
+ ctxt.fail("bad input", sys->sprint("getsexprs: cannot open stdin: %r"));
+ status := "";
+ nerrs := 0;
+ ctxt.push();
+ for(;;){
+ {
+ for (;;) {
+ (se, err) := Sexp.read(stdin);
+ if(err != nil){
+ sys->fprint(sys->fildes(2), "getsexprs: error on read: %s\n", err);
+ if(++nerrs > Maxerrs)
+ raise "fail:too many errors";
+ continue;
+ }
+ if(se == nil)
+ break;
+ nerrs = 0;
+ ctxt.setlocal("sexp", ref Listnode(nil, se.text()) :: nil);
+ status = setstatus(ctxt, ctxt.run(cmd, 0));
+ }
+ ctxt.pop();
+ return status;
+ }exception e{
+ "fail:*" =>
+ ctxt.pop();
+ if (loopexcept(e) == BREAK)
+ return status;
+ ctxt.push();
+ }
+ }
+}
+
+builtin_islist(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ if(argv == nil || tl argv != nil)
+ builtinusage(ctxt, "islist sexp");
+ w := word(hd argv);
+ if(w != nil && w[0] =='(')
+ return nil;
+ if(parse(ctxt, hd argv).islist())
+ return nil;
+ return "not a list";
+}
+
+CONTINUE, BREAK: con iota;
+loopexcept(ename: string): int
+{
+ case ename[5:] {
+ "break" =>
+ return BREAK;
+ "continue" =>
+ return CONTINUE;
+ * =>
+ raise ename;
+ }
+ return 0;
+}
+
+iscmd(n: ref Listnode): int
+{
+ return n.cmd != nil || (n.word != nil && n.word[0] == '{');
+}
+
+builtinusage(ctxt: ref Context, s: string)
+{
+ ctxt.fail("usage", "usage: " + s);
+}
+
+setstatus(ctxt: ref Context, val: string): string
+{
+ ctxt.setlocal("status", ref Listnode(nil, val) :: nil);
+ return val;
+}
+
+sbuiltin_els(ctxt: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ if (val == nil || tl val != nil)
+ builtinusage(ctxt, "els sexp");
+ r, rr: list of ref Listnode;
+ for(els := parse(ctxt, hd val).els(); els != nil; els = tl els)
+ r = ref Listnode(nil, (hd els).text()) :: r;
+ for(; r != nil; r = tl r)
+ rr = hd r :: rr;
+ return rr;
+}
+
+sbuiltin_text(ctxt: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ if(val == nil || tl val != nil)
+ builtinusage(ctxt, "text sexp");
+ return ref Listnode(nil, parse(ctxt, hd val).astext()) :: nil;
+}
+
+sbuiltin_b64(ctxt: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ if(val == nil || tl val != nil)
+ builtinusage(ctxt, "b64 sexp");
+ return ref Listnode(nil, parse(ctxt, hd val).b64text()) :: nil;
+}
+
+sbuiltin_textels(ctxt: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ if (val == nil || tl val != nil)
+ builtinusage(ctxt, "textels sexp");
+ r, rr: list of ref Listnode;
+ for(els := parse(ctxt, hd val).els(); els != nil; els = tl els)
+ r = ref Listnode(nil, (hd els).astext()) :: r;
+ for(; r != nil; r = tl r)
+ rr = hd r :: rr;
+ return rr;
+}
+
+sbuiltin_mktext(ctxt: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ if (val == nil || tl val != nil)
+ builtinusage(ctxt, "mktext sexp");
+ return ref Listnode(nil, (ref Sexp.String(word(hd val), nil)).text()) :: nil;
+}
+
+sbuiltin_mklist(nil: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ if(val == nil)
+ return ref Listnode(nil, "()") :: nil;
+ s := "(" + word(hd val);
+ for(val = tl val; val != nil; val = tl val)
+ s += " " + word(hd val);
+ s[len s] = ')';
+ return ref Listnode(nil, s) :: nil;
+}
+
+sbuiltin_mktextlist(nil: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ if(val == nil)
+ return ref Listnode(nil, "()") :: nil;
+ s := "(" + (ref Sexp.String(word(hd val), nil)).text();
+ for(val = tl val; val != nil; val = tl val)
+ s += " " + (ref Sexp.String(word(hd val), nil)).text();
+ s[len s] = ')';
+ return ref Listnode(nil, s) :: nil;
+}
+
+parse(ctxt: ref Context, val: ref Listnode): ref Sexp
+{
+ (se, rest, err) := Sexp.parse(word(val));
+ if(rest != nil){
+ for(i := 0; i < len rest; i++)
+ if(rest[i] != ' ' && rest[i] != '\t' && rest[i] != '\n')
+ ctxt.fail("bad sexp", sys->sprint("extra text found at end of s-expression %#q", word(val)));
+ }
+ if(err != nil)
+ ctxt.fail("bad sexp", err);
+ return se;
+}
+
+word(n: ref Listnode): string
+{
+ if (n.word != nil)
+ return n.word;
+ if (n.cmd != nil)
+ n.word = sh->cmd2string(n.cmd);
+ return n.word;
+}
diff --git a/appl/cmd/sh/sh.b b/appl/cmd/sh/sh.b
new file mode 100644
index 00000000..6040457f
--- /dev/null
+++ b/appl/cmd/sh/sh.b
@@ -0,0 +1,2843 @@
+implement Sh;
+
+include "sys.m";
+ sys: Sys;
+ sprint: import sys;
+include "draw.m";
+include "bufio.m";
+ bufio: Bufio;
+include "string.m";
+ str: String;
+include "filepat.m";
+ filepat: Filepat;
+include "env.m";
+ env: Env;
+include "sh.m";
+ myself: Sh;
+ myselfbuiltin: Shellbuiltin;
+
+YYSTYPE: adt {
+ node: ref Node;
+ word: string;
+
+ redir: ref Redir;
+ optype: int;
+};
+
+YYLEX: adt {
+ lval: YYSTYPE;
+ err: string; # if error has occurred
+ errline: int; # line it occurred on.
+ path: string; # name of file that's being read.
+
+ # free caret state
+ wasdollar: int;
+ atendword: int;
+ eof: int;
+ cbuf: array of int; # last chars read
+ ncbuf: int; # number of chars in cbuf
+
+ f: ref Bufio->Iobuf;
+ s: string;
+ strpos: int; # string pos/cbuf index
+
+ linenum: int;
+ prompt: string;
+ lastnl: int;
+
+ initstring: fn(s: string): ref YYLEX;
+ initfile: fn(fd: ref Sys->FD, path: string): ref YYLEX;
+ lex: fn(l: self ref YYLEX): int;
+ error: fn(l: self ref YYLEX, err: string);
+ getc: fn(l: self ref YYLEX): int;
+ ungetc: fn(l: self ref YYLEX);
+
+ EOF: con -1;
+};
+
+Options: adt {
+ lflag,
+ nflag: int;
+ ctxtflags: int;
+ carg: string;
+};
+
+
+ # module definition is in shell.m
+DUP: con 57346;
+REDIR: con 57347;
+WORD: con 57348;
+OP: con 57349;
+END: con 57350;
+ERROR: con 57351;
+ANDAND: con 57352;
+OROR: con 57353;
+YYEOFCODE: con 1;
+YYERRCODE: con 2;
+YYMAXDEPTH: con 200;
+
+
+
+EPERM: con "permission denied";
+EPIPE: con "write on closed pipe";
+
+SHELLRC: con "lib/profile";
+LIBSHELLRC: con "/lib/sh/profile";
+BUILTINPATH: con "/dis/sh";
+
+DEBUG: con 0;
+
+ENVSEP: con 0; # word seperator in external environment
+ENVHASHSIZE: con 7; # XXX profile usage of this...
+OAPPEND: con 16r80000; # make sure this doesn't clash with O* constants in sys.m
+OMASK: con 7;
+
+usage()
+{
+ sys->fprint(stderr(), "usage: sh [-ilexn] [-c command] [file [arg...]]\n");
+ raise "fail:usage";
+}
+
+badmodule(path: string)
+{
+ sys->fprint(sys->fildes(2), "sh: cannot load %s: %r\n", path);
+ raise "fail:bad module" ;
+}
+
+initialise()
+{
+ if (sys == nil) {
+ sys = load Sys Sys->PATH;
+
+ filepat = load Filepat Filepat->PATH;
+ if (filepat == nil) badmodule(Filepat->PATH);
+
+ str = load String String->PATH;
+ if (str == nil) badmodule(String->PATH);
+
+ bufio = load Bufio Bufio->PATH;
+ if (bufio == nil) badmodule(Bufio->PATH);
+
+ myself = load Sh "$self";
+ if (myself == nil) badmodule("$self(Sh)");
+
+ myselfbuiltin = load Shellbuiltin "$self";
+ if (myselfbuiltin == nil) badmodule("$self(Shellbuiltin)");
+
+ env = load Env Env->PATH;
+ }
+}
+blankopts: Options;
+init(drawcontext: ref Draw->Context, argv: list of string)
+{
+ initialise();
+ opts := blankopts;
+ if (argv != nil) {
+ if ((hd argv)[0] == '-')
+ opts.lflag++;
+ argv = tl argv;
+ }
+
+ interactive := 0;
+loop: while (argv != nil && hd argv != nil && (hd argv)[0] == '-') {
+ for (i := 1; i < len hd argv; i++) {
+ c := (hd argv)[i];
+ case c {
+ 'i' =>
+ interactive = Context.INTERACTIVE;
+ 'l' =>
+ opts.lflag++; # login (read $home/lib/profile)
+ 'n' =>
+ opts.nflag++; # don't fork namespace
+ 'e' =>
+ opts.ctxtflags |= Context.ERROREXIT;
+ 'x' =>
+ opts.ctxtflags |= Context.EXECPRINT;
+ 'c' =>
+ arg: string;
+ if (i < len hd argv - 1) {
+ arg = (hd argv)[i + 1:];
+ } else if (tl argv == nil || hd tl argv == "") {
+ usage();
+ } else {
+ arg = hd tl argv;
+ argv = tl argv;
+ }
+ argv = tl argv;
+ opts.carg = arg;
+ continue loop;
+ }
+ }
+ argv = tl argv;
+ }
+
+ sys->pctl(Sys->FORKFD, nil);
+ if (!opts.nflag)
+ sys->pctl(Sys->FORKNS, nil);
+ ctxt := Context.new(drawcontext);
+ ctxt.setoptions(opts.ctxtflags, 1);
+ if (opts.carg != nil) {
+ status := ctxt.run(stringlist2list("{" + opts.carg + "}" :: argv), !interactive);
+ if (!interactive) {
+ if (status != nil)
+ raise "fail:" + status;
+ exit;
+ }
+ setstatus(ctxt, status);
+ }
+
+ # if login shell, run standard init script
+ if (opts.lflag)
+ runscript(ctxt, LIBSHELLRC, nil, 0);
+
+ if (argv == nil) {
+ if (opts.lflag)
+ runscript(ctxt, SHELLRC, nil, 0);
+ if (isconsole(sys->fildes(0)))
+ interactive |= ctxt.INTERACTIVE;
+ ctxt.setoptions(interactive, 1);
+ runfile(ctxt, sys->fildes(0), "stdin", nil);
+ } else {
+ ctxt.setoptions(interactive, 1);
+ runscript(ctxt, hd argv, stringlist2list(tl argv), 1);
+ }
+}
+
+parse(s: string): (ref Node, string)
+{
+ initialise();
+
+ lex := YYLEX.initstring(s);
+
+ return doparse(lex, "", 0);
+}
+
+system(drawctxt: ref Draw->Context, cmd: string): string
+{
+ initialise();
+ {
+ (n, err) := parse(cmd);
+ if (err != nil)
+ return err;
+ if (n == nil)
+ return nil;
+ return Context.new(drawctxt).run(ref Listnode(n, nil) :: nil, 0);
+ } exception e {
+ "fail:*" =>
+ return e[5:];
+ }
+}
+
+run(drawctxt: ref Draw->Context, argv: list of string): string
+{
+ initialise();
+ {
+ return Context.new(drawctxt).run(stringlist2list(argv), 0);
+ } exception e {
+ "fail:*" =>
+ return e[5:];
+ }
+}
+
+isconsole(fd: ref Sys->FD): int
+{
+ (ok1, d1) := sys->fstat(fd);
+ (ok2, d2) := sys->stat("/dev/cons");
+ if (ok1 < 0 || ok2 < 0)
+ return 0;
+ return d1.dtype == d2.dtype && d1.qid.path == d2.qid.path;
+}
+
+runscript(ctxt: ref Context, path: string, args: list of ref Listnode, reporterr: int)
+{
+ {
+ fd := sys->open(path, Sys->OREAD);
+ if (fd != nil)
+ runfile(ctxt, fd, path, args);
+ else if (reporterr)
+ ctxt.fail("bad script path", sys->sprint("sh: cannot open %s: %r", path));
+ } exception e {
+ "fail:*" =>
+ if(!reporterr)
+ return;
+ raise;
+ }
+}
+
+runfile(ctxt: ref Context, fd: ref Sys->FD, path: string, args: list of ref Listnode)
+{
+ ctxt.push();
+ {
+ ctxt.setlocal("0", stringlist2list(path :: nil));
+ ctxt.setlocal("*", args);
+ lex := YYLEX.initfile(fd, path);
+ if (DEBUG) debug(sprint("parse(interactive == %d)", (ctxt.options() & ctxt.INTERACTIVE) != 0));
+ prompt := "" :: "" :: nil;
+ laststatus: string;
+ while (!lex.eof) {
+ interactive := ctxt.options() & ctxt.INTERACTIVE;
+ if (interactive) {
+ prompt = list2stringlist(ctxt.get("prompt"));
+ if (prompt == nil)
+ prompt = "; " :: "" :: nil;
+
+ sys->fprint(stderr(), "%s", hd prompt);
+ if (tl prompt == nil) {
+ prompt = hd prompt :: "" :: nil;
+ }
+ }
+ (n, err) := doparse(lex, hd tl prompt, !interactive);
+ if (err != nil) {
+ sys->fprint(stderr(), "sh: %s\n", err);
+ if (!interactive)
+ raise "fail:parse error";
+ } else if (n != nil) {
+ if (interactive) {
+ {
+ laststatus = walk(ctxt, n, 0);
+ } exception e2 {
+ "fail:*" =>
+ laststatus = e2[5:];
+ }
+ } else
+ laststatus = walk(ctxt, n, 0);
+ setstatus(ctxt, laststatus);
+ if ((ctxt.options() & ctxt.ERROREXIT) && laststatus != nil)
+ break;
+ }
+ }
+ if (laststatus != nil)
+ raise "fail:" + laststatus;
+ ctxt.pop();
+ }
+ exception e {
+ "fail:*" =>
+ ctxt.pop();
+ raise;
+ }
+}
+
+nonexistent(e: string): int
+{
+ errs := array[] of {"does not exist", "directory entry not found"};
+ for (i := 0; i < len errs; i++){
+ j := len errs[i];
+ if (j <= len e && e[len e-j:] == errs[i])
+ return 1;
+ }
+ return 0;
+}
+
+Redirword: adt {
+ fd: ref Sys->FD;
+ w: string;
+ r: Redir;
+};
+
+Redirlist: adt {
+ r: list of Redirword;
+};
+
+pipe2cmd(n: ref Node): ref Node
+{
+ if (n == nil || n.ntype != n_PIPE)
+ return n;
+ return mk(n_ADJ, mk(n_BLOCK,n,nil), mk(n_VAR,ref Node(n_WORD,nil,nil,"*",nil),nil));
+}
+
+walk(ctxt: ref Context, n: ref Node, last: int): string
+{
+ if (DEBUG) debug(sprint("walking: %s", cmd2string(n)));
+ # avoid tail recursion stack explosion
+ while (n != nil && n.ntype == n_SEQ) {
+ status := walk(ctxt, n.left, 0);
+ if (ctxt.options() & ctxt.ERROREXIT && status != nil)
+ raise "fail:" + status;
+ setstatus(ctxt, status);
+ n = n.right;
+ }
+ if (n == nil)
+ return nil;
+ case (n.ntype) {
+ n_PIPE =>
+ return waitfor(ctxt, walkpipeline(ctxt, n, nil, -1));
+ n_ASSIGN or n_LOCAL =>
+ assign(ctxt, n);
+ return nil;
+ * =>
+ bg := 0;
+ if (n.ntype == n_NOWAIT) {
+ bg = 1;
+ n = pipe2cmd(n.left);
+ }
+
+ redirs := ref Redirlist(nil);
+ line := glob(glom(ctxt, n, redirs, nil));
+
+ if (bg) {
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 1, line, redirs, startchan);
+ (pid, nil) := <-startchan;
+ redirs = nil;
+ if (DEBUG) debug("started background process "+ string pid);
+ ctxt.set("apid", ref Listnode(nil, string pid) :: nil);
+ return nil;
+ } else {
+ return runsync(ctxt, line, redirs, last);
+ }
+ }
+}
+
+assign(ctxt: ref Context, n: ref Node): list of ref Listnode
+{
+ redirs := ref Redirlist;
+ val: list of ref Listnode;
+ if (n.right != nil && (n.right.ntype == n_ASSIGN || n.right.ntype == n_LOCAL))
+ val = assign(ctxt, n.right);
+ else
+ val = glob(glom(ctxt, n.right, redirs, nil));
+ vars := glom(ctxt, n.left, redirs, nil);
+ if (vars == nil)
+ ctxt.fail("bad assign", "sh: nil variable name");
+ if (redirs.r != nil)
+ ctxt.fail("bad assign", "sh: redirections not allowed in assignment");
+ tval := val;
+ for (; vars != nil; vars = tl vars) {
+ vname := deglob((hd vars).word);
+ if (vname == nil)
+ ctxt.fail("bad assign", "sh: bad variable name");
+ v: list of ref Listnode = nil;
+ if (tl vars == nil)
+ v = tval;
+ else if (tval != nil)
+ v = hd tval :: nil;
+ if (n.ntype == n_ASSIGN)
+ ctxt.set(vname, v);
+ else
+ ctxt.setlocal(vname, v);
+ if (tval != nil)
+ tval = tl tval;
+ }
+ return val;
+}
+
+walkpipeline(ctxt: ref Context, n: ref Node, wrpipe: ref Sys->FD, wfdno: int): list of int
+{
+ if (n == nil)
+ return nil;
+
+ fds := array[2] of ref Sys->FD;
+ pids: list of int;
+ rfdno := -1;
+ if (n.ntype == n_PIPE) {
+ if (sys->pipe(fds) == -1)
+ ctxt.fail("no pipe", sys->sprint("sh: cannot make pipe: %r"));
+ nwfdno := -1;
+ if (n.redir != nil) {
+ (fd1, fd2) := (n.redir.fd2, n.redir.fd1);
+ if (fd2 == -1)
+ (fd1, fd2) = (fd2, fd1);
+ (nwfdno, rfdno) = (fd2, fd1);
+ }
+ pids = walkpipeline(ctxt, n.left, fds[1], nwfdno);
+ fds[1] = nil;
+ n = n.right;
+ }
+ r := ref Redirlist(nil);
+ rlist := glob(glom(ctxt, n, r, nil));
+ if (fds[0] != nil) {
+ if (rfdno == -1)
+ rfdno = 0;
+ r.r = Redirword(fds[0], nil, Redir(Sys->OREAD, rfdno, -1)) :: r.r;
+ }
+ if (wrpipe != nil) {
+ if (wfdno == -1)
+ wfdno = 1;
+ r.r = Redirword(wrpipe, nil, Redir(Sys->OWRITE, wfdno, -1)) :: r.r;
+ }
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 1, rlist, r, startchan);
+ (pid, nil) := <-startchan;
+ if (DEBUG) debug("started pipe process "+string pid);
+ return pid :: pids;
+}
+
+makeredir(f: string, mode: int, fd: int): Redirword
+{
+ return Redirword(nil, f, Redir(mode, fd, -1));
+}
+
+glom(ctxt: ref Context, n: ref Node, redirs: ref Redirlist, onto: list of ref Listnode)
+ : list of ref Listnode
+{
+ if (n == nil) return nil;
+
+ if (n.ntype != n_ADJ)
+ return listjoin(glomoperation(ctxt, n, redirs), onto);
+
+ nlist := glom(ctxt, n.right, redirs, onto);
+
+ if (n.left.ntype != n_ADJ) {
+ # if it's a terminal node
+ nlist = listjoin(glomoperation(ctxt, n.left, redirs), nlist);
+ } else
+ nlist = glom(ctxt, n.left, redirs, nlist);
+ return nlist;
+}
+
+listjoin(left, right: list of ref Listnode): list of ref Listnode
+{
+ l: list of ref Listnode;
+ for (; left != nil; left = tl left)
+ l = hd left :: l;
+ for (; l != nil; l = tl l)
+ right = hd l :: right;
+ return right;
+}
+
+glomoperation(ctxt: ref Context, n: ref Node, redirs: ref Redirlist): list of ref Listnode
+{
+ if (n == nil)
+ return nil;
+
+ nlist: list of ref Listnode;
+ case n.ntype {
+ n_WORD =>
+ nlist = ref Listnode(nil, n.word) :: nil;
+ n_REDIR =>
+ wlist := glob(glom(ctxt, n.left, ref Redirlist(nil), nil));
+ if (len wlist != 1 || (hd wlist).word == nil)
+ ctxt.fail("bad redir", "sh: single redirection operand required");
+
+ # add to redir list
+ redirs.r = Redirword(nil, (hd wlist).word, *n.redir) :: redirs.r;
+ n_DUP =>
+ redirs.r = Redirword(nil, "", *n.redir) :: redirs.r;
+ n_LIST =>
+ nlist = glom(ctxt, n.left, redirs, nil);
+ n_CONCAT =>
+ nlist = concat(ctxt, glom(ctxt, n.left, redirs, nil), glom(ctxt, n.right, redirs, nil));
+ n_VAR or n_SQUASH or n_COUNT =>
+ arg := glom(ctxt, n.left, ref Redirlist(nil), nil);
+ if (len arg == 1 && (hd arg).cmd != nil)
+ nlist = subsbuiltin(ctxt, (hd arg).cmd.left);
+ else if (len arg != 1 || (hd arg).word == nil)
+ ctxt.fail("bad $ arg", "sh: bad variable name");
+ else
+ nlist = ctxt.get(deglob((hd arg).word));
+ case n.ntype {
+ n_VAR =>;
+ n_COUNT =>
+ nlist = ref Listnode(nil, string len nlist) :: nil;
+ n_SQUASH =>
+ # XXX could squash with first char of $ifs, perhaps
+ nlist = ref Listnode(nil, squash(list2stringlist(nlist), " ")) :: nil;
+ }
+ n_BQ or n_BQ2 =>
+ arg := glom(ctxt, n.left, ref Redirlist(nil), nil);
+ seps := "";
+ if (n.ntype == n_BQ) {
+ seps = squash(list2stringlist(ctxt.get("ifs")), "");
+ if (seps == nil)
+ seps = " \t\n\r";
+ }
+ (nlist, nil) = bq(ctxt, glob(arg), seps);
+ n_BLOCK =>
+ nlist = ref Listnode(n, "") :: nil;
+ n_ASSIGN or n_LOCAL =>
+ ctxt.fail("bad assign", "sh: assignment in invalid context");
+ * =>
+ panic("bad node type "+string n.ntype+" in glomop");
+ }
+ return nlist;
+}
+
+subsbuiltin(ctxt: ref Context, n: ref Node): list of ref Listnode
+{
+ if (n == nil || n.ntype == n_SEQ ||
+ n.ntype == n_PIPE || n.ntype == n_NOWAIT)
+ ctxt.fail("bad $ arg", "sh: invalid argument to ${} operator");
+ r := ref Redirlist;
+ cmd := glob(glom(ctxt, n, r, nil));
+ if (r.r != nil)
+ ctxt.fail("bad $ arg", "sh: redirection not allowed in substitution");
+ r = nil;
+ if (cmd == nil || (hd cmd).word == nil || (hd cmd).cmd != nil)
+ ctxt.fail("bad $ arg", "sh: bad builtin name");
+
+ (nil, bmods) := findbuiltin(ctxt.env.sbuiltins, (hd cmd).word);
+ if (bmods == nil)
+ ctxt.fail("builtin not found",
+ sys->sprint("sh: builtin %s not found", (hd cmd).word));
+ return (hd bmods)->runsbuiltin(ctxt, myself, cmd);
+}
+
+
+getbq(nil: ref Context, fd: ref Sys->FD, seps: string): list of ref Listnode
+{
+ buf := array[Sys->ATOMICIO] of byte;
+ buflen := 0;
+ while ((n := sys->read(fd, buf[buflen:], len buf - buflen)) > 0) {
+ buflen += n;
+ if (buflen == len buf) {
+ nbuf := array[buflen * 2] of byte;
+ nbuf[0:] = buf[0:];
+ buf = nbuf;
+ }
+ }
+ l: list of string;
+ if (seps != nil)
+ (nil, l) = sys->tokenize(string buf[0:buflen], seps);
+ else
+ l = string buf[0:buflen] :: nil;
+ buf = nil;
+ return stringlist2list(l);
+}
+
+bq(ctxt: ref Context, cmd: list of ref Listnode, seps: string): (list of ref Listnode, string)
+{
+ fds := array[2] of ref Sys->FD;
+ if (sys->pipe(fds) == -1)
+ ctxt.fail("no pipe", sys->sprint("sh: cannot make pipe: %r"));
+
+ r := rdir(fds[1]);
+ fds[1] = nil;
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 0, cmd, r, startchan);
+ (exepid, exprop) := <-startchan;
+ r = nil;
+ bqlist := getbq(ctxt, fds[0], seps);
+ waitfor(ctxt, exepid :: nil);
+ if (exprop.name != nil)
+ raise exprop.name;
+ return (bqlist, nil);
+}
+
+rdir(fd: ref Sys->FD): ref Redirlist
+{
+ return ref Redirlist(Redirword(fd, nil, Redir(Sys->OWRITE, 1, -1)) :: nil);
+}
+
+
+concatwords(p1, p2: ref Listnode): ref Listnode
+{
+ if (p1.word == nil && p1.cmd != nil)
+ p1.word = cmd2string(p1.cmd);
+ if (p2.word == nil && p2.cmd != nil)
+ p2.word = cmd2string(p2.cmd);
+ return ref Listnode(nil, p1.word + p2.word);
+}
+
+concat(ctxt: ref Context, nl1, nl2: list of ref Listnode): list of ref Listnode
+{
+ if (nl1 == nil || nl2 == nil) {
+ if (nl1 == nil && nl2 == nil)
+ return nil;
+ ctxt.fail("bad concatenation", "sh: null list in concatenation");
+ }
+
+ ret: list of ref Listnode;
+ if (tl nl1 == nil || tl nl2 == nil) {
+ for (p1 := nl1; p1 != nil; p1 = tl p1)
+ for (p2 := nl2; p2 != nil; p2 = tl p2)
+ ret = concatwords(hd p1, hd p2) :: ret;
+ } else {
+ if (len nl1 != len nl2)
+ ctxt.fail("bad concatenation", "sh: lists of differing sizes can't be concatenated");
+ while (nl1 != nil) {
+ ret = concatwords(hd nl1, hd nl2) :: ret;
+ (nl1, nl2) = (tl nl1, tl nl2);
+ }
+ }
+ return revlist(ret);
+}
+
+Expropagate: adt {
+ name: string;
+};
+
+runasync(ctxt: ref Context, copyenv: int, argv: list of ref Listnode, redirs: ref Redirlist,
+ startchan: chan of (int, ref Expropagate))
+{
+ status: string;
+
+ pid := sys->pctl(sys->FORKFD, nil);
+ if (DEBUG) debug(sprint("in async (len redirs: %d)", len redirs.r));
+ ctxt = ctxt.copy(copyenv);
+ exprop := ref Expropagate;
+ {
+ newfdl := doredirs(ctxt, redirs);
+ redirs = nil;
+ if (newfdl != nil)
+ sys->pctl(Sys->NEWFD, newfdl);
+ # stop the old waitfd from holding the intermediate
+ # file descriptor group open.
+ ctxt.waitfd = waitfd();
+ # N.B. it's important that the sync is done here, not
+ # before doredirs, as otherwise there's some sort of
+ # race condition that leads to pipe non-completion.
+ startchan <-= (pid, exprop);
+ startchan = nil;
+ status = ctxt.run(argv, copyenv);
+ } exception e {
+ "fail:*" =>
+ exprop.name = e;
+ if (startchan != nil)
+ startchan <-= (pid, exprop);
+ raise e;
+ }
+ if (status != nil) {
+ # don't propagate bad status as an exception.
+ raise "fail:" + status;
+ }
+}
+
+runsync(ctxt: ref Context, argv: list of ref Listnode,
+ redirs: ref Redirlist, last: int): string
+{
+ if (DEBUG) debug(sys->sprint("in sync (len redirs: %d; last: %d)", len redirs.r, last));
+ if (redirs.r != nil && !last) {
+ # a new process is required to shield redirection side effects
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 0, argv, redirs, startchan);
+ (pid, exprop) := <-startchan;
+ redirs = nil;
+ r := waitfor(ctxt, pid :: nil);
+ if (exprop.name != nil)
+ raise exprop.name;
+ return r;
+ } else {
+ newfdl := doredirs(ctxt, redirs);
+ redirs = nil;
+ if (newfdl != nil)
+ sys->pctl(Sys->NEWFD, newfdl);
+ return ctxt.run(argv, last);
+ }
+}
+
+absolute(p: string): int
+{
+ if (len p < 2)
+ return 0;
+ if (p[0] == '/' || p[0] == '#')
+ return 1;
+ if (len p < 3 || p[0] != '.')
+ return 0;
+ if (p[1] == '/')
+ return 1;
+ if (p[1] == '.' && p[2] == '/')
+ return 1;
+ return 0;
+}
+
+runexternal(ctxt: ref Context, args: list of ref Listnode, last: int): string
+{
+ progname := (hd args).word;
+ disfile := 0;
+ if (len progname >= 4 && progname[len progname-4:] == ".dis")
+ disfile = 1;
+ pathlist: list of string;
+ if (absolute(progname))
+ pathlist = list of {""};
+ else if ((pl := ctxt.get("path")) != nil)
+ pathlist = list2stringlist(pl);
+ else
+ pathlist = list of {"/dis", "."};
+
+ err := "";
+ do {
+ path: string;
+ if (hd pathlist != "")
+ path = hd pathlist + "/" + progname;
+ else
+ path = progname;
+
+ npath := path;
+ if (!disfile)
+ npath += ".dis";
+ mod := load Command npath;
+ if (mod != nil) {
+ argv := list2stringlist(args);
+ export(ctxt.env.localenv);
+
+ if (last) {
+ {
+ sys->pctl(Sys->NEWFD, ctxt.keepfds);
+ mod->init(ctxt.drawcontext, argv);
+ exit;
+ } exception e {
+ EPIPE =>
+ return EPIPE;
+ "fail:*" =>
+ return e[5:];
+ }
+ }
+ extstart := chan of int;
+ spawn externalexec(mod, ctxt.drawcontext, argv, extstart, ctxt.keepfds);
+ pid := <-extstart;
+ if (DEBUG) debug("started external externalexec; pid is "+string pid);
+ return waitfor(ctxt, pid :: nil);
+ }
+ err = sys->sprint("%r");
+ if (nonexistent(err)) {
+ # try and run it as a shell script
+ if (!disfile && (fd := sys->open(path, Sys->OREAD)) != nil) {
+ (ok, info) := sys->fstat(fd);
+ # make permission checking more accurate later
+ if (ok == 0 && (info.mode & Sys->DMDIR) == 0
+ && (info.mode & 8r111) != 0)
+ return runhashpling(ctxt, fd, path, tl args, last);
+ };
+ err = sys->sprint("%r");
+ }
+ pathlist = tl pathlist;
+ } while (pathlist != nil && nonexistent(err));
+ diagnostic(ctxt, sys->sprint("%s: %s", progname, err));
+ return err;
+}
+
+runhashpling(ctxt: ref Context, fd: ref Sys->FD,
+ path: string, argv: list of ref Listnode, last: int): string
+{
+ header := array[1024] of byte;
+ n := sys->read(fd, header, len header);
+ for (i := 0; i < n; i++)
+ if (header[i] == byte '\n')
+ break;
+ if (i == n || i < 3 || header[0] != byte('#') || header[1] != byte('!')) {
+ diagnostic(ctxt, "bad script header on " + path);
+ return "bad header";
+ }
+ (nil, args) := sys->tokenize(string header[2:i], " \t");
+ if (args == nil) {
+ diagnostic(ctxt, "empty header on " + path);
+ return "bad header";
+ }
+ header = nil;
+ fd = nil;
+ nargs: list of ref Listnode;
+ for (; args != nil; args = tl args)
+ nargs = ref Listnode(nil, hd args) :: nargs;
+ nargs = ref Listnode(nil, path) :: nargs;
+ for (; argv != nil; argv = tl argv)
+ nargs = hd argv :: nargs;
+ return runexternal(ctxt, revlist(nargs), last);
+}
+
+runblock(ctxt: ref Context, args: list of ref Listnode, last: int): string
+{
+ # block execute (we know that hd args represents a block)
+ cmd := (hd args).cmd;
+ if (cmd == nil) {
+ # parse block from first argument
+ lex := YYLEX.initstring((hd args).word);
+
+ err: string;
+ (cmd, err) = doparse(lex, "", 0);
+ if (cmd == nil)
+ ctxt.fail("parse error", "sh: "+err);
+
+ (hd args).cmd = cmd;
+ }
+ # now we've got a parsed block
+ ctxt.push();
+ {
+ ctxt.setlocal("0", hd args :: nil);
+ ctxt.setlocal("*", tl args);
+ if (cmd != nil && cmd.ntype == n_BLOCK)
+ cmd = cmd.left;
+ status := walk(ctxt, cmd, last);
+ ctxt.pop();
+ return status;
+ } exception e{
+ "fail:*" =>
+ ctxt.pop();
+ raise;
+ }
+}
+
+trybuiltin(ctxt: ref Context, args: list of ref Listnode, lseq: int)
+ : (int, string)
+{
+ (n, bmods) := findbuiltin(ctxt.env.builtins, (hd args).word);
+ if (bmods == nil)
+ return (0, nil);
+ return (1, (hd bmods)->runbuiltin(ctxt, myself, args, lseq));
+}
+
+keepfdstr(ctxt: ref Context): string
+{
+ s := "";
+ for (f := ctxt.keepfds; f != nil; f = tl f) {
+ s += string hd f;
+ if (tl f != nil)
+ s += ",";
+ }
+ return s;
+}
+
+externalexec(mod: Command,
+ drawcontext: ref Draw->Context, argv: list of string, startchan: chan of int, keepfds: list of int)
+{
+ if (DEBUG) debug(sprint("externalexec(%s,... [%d args])", hd argv, len argv));
+ sys->pctl(Sys->NEWFD, keepfds);
+ startchan <-= sys->pctl(0, nil);
+ {
+ mod->init(drawcontext, argv);
+ }
+ exception e{
+ EPIPE =>
+ raise "fail:" + EPIPE;
+ }
+}
+
+dup(ctxt: ref Context, fd1, fd2: int): int
+{
+ # shuffle waitfd out of the way if it's being attacked
+ if (ctxt.waitfd.fd == fd2) {
+ ctxt.waitfd = waitfd();
+ if (ctxt.waitfd.fd == fd2)
+ panic(sys->sprint("reopen of waitfd gave same fd (%d)", ctxt.waitfd.fd));
+ }
+ return sys->dup(fd1, fd2);
+}
+
+doredirs(ctxt: ref Context, redirs: ref Redirlist): list of int
+{
+ if (redirs.r == nil)
+ return nil;
+ keepfds := ctxt.keepfds;
+ rl := redirs.r;
+ redirs = nil;
+ for (; rl != nil; rl = tl rl) {
+ (rfd, path, (mode, fd1, fd2)) := hd rl;
+ if (path == nil && rfd == nil) {
+ # dup
+ if (fd1 == -1 || fd2 == -1)
+ ctxt.fail("bad redir", "sh: invalid dup");
+
+ if (dup(ctxt, fd2, fd1) == -1)
+ ctxt.fail("bad redir", sys->sprint("sh: cannot dup: %r"));
+ keepfds = fd1 :: keepfds;
+ continue;
+ }
+ # redir
+ if (fd1 == -1) {
+ if ((mode & OMASK) == Sys->OWRITE)
+ fd1 = 1;
+ else
+ fd1 = 0;
+ }
+ if (rfd == nil) {
+ (append, omode) := (mode & OAPPEND, mode & ~OAPPEND);
+ err := "";
+ case mode {
+ Sys->OREAD =>
+ rfd = sys->open(path, omode);
+ Sys->OWRITE | OAPPEND or
+ Sys->ORDWR =>
+ rfd = sys->open(path, omode);
+ err = sprint("%r");
+ if (rfd == nil && nonexistent(err)) {
+ rfd = sys->create(path, omode, 8r666);
+ err = nil;
+ }
+ Sys->OWRITE =>
+ rfd = sys->create(path, omode, 8r666);
+ err = sprint("%r");
+ if (rfd == nil && err == EPERM) {
+ # try open; can't create on a file2chan (pipe)
+ rfd = sys->open(path, omode);
+ nerr := sprint("%r");
+ if(!nonexistent(nerr))
+ err = nerr;
+ }
+ }
+ if (rfd == nil) {
+ if (err == nil)
+ err = sprint("%r");
+ ctxt.fail("bad redir", sys->sprint("sh: cannot open %s: %s", path, err));
+ }
+ if (append)
+ sys->seek(rfd, big 0, Sys->SEEKEND); # not good enough, but alright for some purposes.
+ }
+ # XXX what happens if rfd.fd == fd1?
+ # it probably gets closed automatically... which is not what we want!
+ dup(ctxt, rfd.fd, fd1);
+ keepfds = fd1 :: keepfds;
+ }
+ ctxt.keepfds = keepfds;
+ return ctxt.waitfd.fd :: keepfds;
+}
+
+
+waitfd(): ref Sys->FD
+{
+ wf := string sys->pctl(0, nil) + "/wait";
+ waitfd := sys->open("#p/"+wf, Sys->OREAD);
+ if (waitfd == nil)
+ waitfd = sys->open("/prog/"+wf, Sys->OREAD);
+ if (waitfd == nil)
+ panic(sys->sprint("cannot open wait file: %r"));
+ return waitfd;
+}
+
+waitfor(ctxt: ref Context, pids: list of int): string
+{
+ if (pids == nil)
+ return nil;
+ status := array[len pids] of string;
+ wcount := len status;
+ buf := array[Sys->WAITLEN] of byte;
+ onebad := 0;
+ for(;;){
+ n := sys->read(ctxt.waitfd, buf, len buf);
+ if(n < 0)
+ panic(sys->sprint("error on wait read: %r"));
+ (who, line, s) := parsewaitstatus(ctxt, string buf[0:n]);
+ if (s != nil) {
+ if (len s >= 5 && s[0:5] == "fail:")
+ s = s[5:];
+ else
+ diagnostic(ctxt, line);
+ }
+ for ((i, pl) := (0, pids); pl != nil; (i, pl) = (i+1, tl pl))
+ if (who == hd pl)
+ break;
+ if (i < len status) {
+ # wait returns two records for a killed process...
+ if (status[i] == nil || s != "killed") {
+ onebad += s != nil;
+ status[i] = s;
+ if (wcount-- <= 1)
+ break;
+ }
+ }
+ }
+ if (!onebad)
+ return nil;
+ r := status[len status - 1];
+ for (i := len status - 2; i >= 0; i--)
+ r += "|" + status[i];
+ return r;
+}
+
+parsewaitstatus(ctxt: ref Context, status: string): (int, string, string)
+{
+ for (i := 0; i < len status; i++)
+ if (status[i] == ' ')
+ break;
+ if (i == len status - 1 || status[i+1] != '"')
+ ctxt.fail("bad wait read",
+ sys->sprint("sh: bad exit status '%s'", status));
+
+ for (i+=2; i < len status; i++)
+ if (status[i] == '"')
+ break;
+ if (i > len status - 2 || status[i+1] != ':')
+ ctxt.fail("bad wait read",
+ sys->sprint("sh: bad exit status '%s'", status));
+
+ return (int status, status, status[i+2:]);
+}
+
+panic(s: string)
+{
+ sys->fprint(stderr(), "sh panic: %s\n", s);
+ raise "panic";
+}
+
+diagnostic(ctxt: ref Context, s: string)
+{
+ if (ctxt.options() & Context.VERBOSE)
+ sys->fprint(stderr(), "sh: %s\n", s);
+}
+
+
+Context.new(drawcontext: ref Draw->Context): ref Context
+{
+ initialise();
+ if (env != nil)
+ env->clone();
+ ctxt := ref Context(
+ ref Environment(
+ ref Builtins(nil, 0),
+ ref Builtins(nil, 0),
+ nil,
+ newlocalenv(nil)
+ ),
+ waitfd(),
+ drawcontext,
+ 0 :: 1 :: 2 :: nil
+ );
+ myselfbuiltin->initbuiltin(ctxt, myself);
+ ctxt.env.localenv.flags = ctxt.VERBOSE;
+ for (vl := ctxt.get("autoload"); vl != nil; vl = tl vl)
+ if ((hd vl).cmd == nil && (hd vl).word != nil)
+ loadmodule(ctxt, (hd vl).word);
+ return ctxt;
+}
+
+Context.copy(ctxt: self ref Context, copyenv: int): ref Context
+{
+ # XXX could check to see that we are definitely in a
+ # new process, because there'll be problems if not (two processes
+ # simultaneously reading the same wait file)
+ nctxt := ref Context(ctxt.env, waitfd(), ctxt.drawcontext, ctxt.keepfds);
+
+ if (copyenv) {
+ if (env != nil)
+ env->clone();
+ nctxt.env = ref Environment(
+ copybuiltins(ctxt.env.sbuiltins),
+ copybuiltins(ctxt.env.builtins),
+ ctxt.env.bmods,
+ copylocalenv(ctxt.env.localenv)
+ );
+ }
+ return nctxt;
+}
+
+Context.set(ctxt: self ref Context, name: string, val: list of ref Listnode)
+{
+ e := ctxt.env.localenv;
+ idx := hashfn(name, len e.vars);
+ for (;;) {
+ v := hashfind(e.vars, idx, name);
+ if (v == nil) {
+ if (e.pushed == nil) {
+ flags := Var.CHANGED;
+ if (noexport(name))
+ flags |= Var.NOEXPORT;
+ hashadd(e.vars, idx, ref Var(name, val, flags));
+ return;
+ }
+ } else {
+ v.val = val;
+ v.flags |= Var.CHANGED;
+ return;
+ }
+ e = e.pushed;
+ }
+}
+
+Context.get(ctxt: self ref Context, name: string): list of ref Listnode
+{
+ if (name == nil)
+ return nil;
+
+ idx := -1;
+ # cope with $1, $2, etc
+ if (name[0] > '0' && name[0] <= '9') {
+ i: int;
+ for (i = 0; i < len name; i++)
+ if (name[i] < '0' || name[i] > '9')
+ break;
+ if (i >= len name) {
+ idx = int name - 1;
+ name = "*";
+ }
+ }
+
+ v := varfind(ctxt.env.localenv, name);
+ if (v != nil) {
+ if (idx != -1)
+ return index(v.val, idx);
+ return v.val;
+ }
+ return nil;
+}
+
+Context.envlist(ctxt: self ref Context): list of (string, list of ref Listnode)
+{
+ t := array[ENVHASHSIZE] of list of ref Var;
+ for (e := ctxt.env.localenv; e != nil; e = e.pushed) {
+ for (i := 0; i < len e.vars; i++) {
+ for (vl := e.vars[i]; vl != nil; vl = tl vl) {
+ v := hd vl;
+ idx := hashfn(v.name, len e.vars);
+ if (hashfind(t, idx, v.name) == nil)
+ hashadd(t, idx, v);
+ }
+ }
+ }
+
+ l: list of (string, list of ref Listnode);
+ for (i := 0; i < ENVHASHSIZE; i++) {
+ for (vl := t[i]; vl != nil; vl = tl vl) {
+ v := hd vl;
+ l = (v.name, v.val) :: l;
+ }
+ }
+ return l;
+}
+
+Context.setlocal(ctxt: self ref Context, name: string, val: list of ref Listnode)
+{
+ e := ctxt.env.localenv;
+ idx := hashfn(name, len e.vars);
+ v := hashfind(e.vars, idx, name);
+ if (v == nil) {
+ flags := Var.CHANGED;
+ if (noexport(name))
+ flags |= Var.NOEXPORT;
+ hashadd(e.vars, idx, ref Var(name, val, flags));
+ } else {
+ v.val = val;
+ v.flags |= Var.CHANGED;
+ }
+}
+
+
+Context.push(ctxt: self ref Context)
+{
+ ctxt.env.localenv = newlocalenv(ctxt.env.localenv);
+}
+
+Context.pop(ctxt: self ref Context)
+{
+ if (ctxt.env.localenv.pushed == nil)
+ panic("unbalanced contexts in shell environment");
+ else {
+ oldv := ctxt.env.localenv.vars;
+ ctxt.env.localenv = ctxt.env.localenv.pushed;
+ for (i := 0; i < len oldv; i++) {
+ for (vl := oldv[i]; vl != nil; vl = tl vl) {
+ if ((v := varfind(ctxt.env.localenv, (hd vl).name)) != nil)
+ v.flags |= Var.CHANGED;
+ else
+ ctxt.set((hd vl).name, nil);
+ }
+ }
+ }
+}
+
+Context.run(ctxt: self ref Context, args: list of ref Listnode, last: int): string
+{
+ if (args == nil || ((hd args).cmd == nil && (hd args).word == nil))
+ return nil;
+ cmd := hd args;
+ if (cmd.cmd != nil || cmd.word[0] == '{') # }
+ return runblock(ctxt, args, last);
+
+ if (ctxt.options() & ctxt.EXECPRINT)
+ sys->fprint(stderr(), "%s\n", quoted(args, 0));
+ (doneit, status) := trybuiltin(ctxt, args, last);
+ if (!doneit)
+ status = runexternal(ctxt, args, last);
+
+ return status;
+}
+
+Context.addmodule(ctxt: self ref Context, name: string, mod: Shellbuiltin)
+{
+ mod->initbuiltin(ctxt, myself);
+ ctxt.env.bmods = (name, mod->getself()) :: ctxt.env.bmods;
+}
+
+Context.addbuiltin(c: self ref Context, name: string, mod: Shellbuiltin)
+{
+ addbuiltin(c.env.builtins, name, mod);
+}
+
+Context.removebuiltin(c: self ref Context, name: string, mod: Shellbuiltin)
+{
+ removebuiltin(c.env.builtins, name, mod);
+}
+
+Context.addsbuiltin(c: self ref Context, name: string, mod: Shellbuiltin)
+{
+ addbuiltin(c.env.sbuiltins, name, mod);
+}
+
+Context.removesbuiltin(c: self ref Context, name: string, mod: Shellbuiltin)
+{
+ removebuiltin(c.env.sbuiltins, name, mod);
+}
+
+varfind(e: ref Localenv, name: string): ref Var
+{
+ idx := hashfn(name, len e.vars);
+ for (; e != nil; e = e.pushed)
+ for (vl := e.vars[idx]; vl != nil; vl = tl vl)
+ if ((hd vl).name == name)
+ return hd vl;
+ return nil;
+}
+
+Context.fail(ctxt: self ref Context, ename: string, err: string)
+{
+ if (ctxt.options() & Context.VERBOSE)
+ sys->fprint(stderr(), "%s\n", err);
+ raise "fail:" + ename;
+}
+
+Context.setoptions(ctxt: self ref Context, flags, on: int): int
+{
+ old := ctxt.env.localenv.flags;
+ if (on)
+ ctxt.env.localenv.flags |= flags;
+ else
+ ctxt.env.localenv.flags &= ~flags;
+ return old;
+}
+
+Context.options(ctxt: self ref Context): int
+{
+ return ctxt.env.localenv.flags;
+}
+
+hashfn(s: string, n: int): int
+{
+ h := 0;
+ m := len s;
+ for(i:=0; i<m; i++){
+ h = 65599*h+s[i];
+ }
+ return (h & 16r7fffffff) % n;
+}
+
+hashfind(ht: array of list of ref Var, idx: int, n: string): ref Var
+{
+ for (ent := ht[idx]; ent != nil; ent = tl ent)
+ if ((hd ent).name == n)
+ return hd ent;
+ return nil;
+}
+
+hashadd(ht: array of list of ref Var, idx: int, v: ref Var)
+{
+ ht[idx] = v :: ht[idx];
+}
+
+copylocalenv(e: ref Localenv): ref Localenv
+{
+ nvars := array[len e.vars] of list of ref Var;
+ flags := e.flags;
+ for (; e != nil; e = e.pushed)
+ for (i := 0; i < len nvars; i++)
+ for (vl := e.vars[i]; vl != nil; vl = tl vl) {
+ idx := hashfn((hd vl).name, len nvars);
+ if (hashfind(nvars, idx, (hd vl).name) == nil)
+ hashadd(nvars, idx, ref *(hd vl));
+ }
+ return ref Localenv(nvars, nil, flags);
+}
+
+newlocalenv(pushed: ref Localenv): ref Localenv
+{
+ e := ref Localenv(array[ENVHASHSIZE] of list of ref Var, pushed, 0);
+ if (pushed == nil && env != nil) {
+ for (vl := env->getall(); vl != nil; vl = tl vl) {
+ (name, val) := hd vl;
+ hashadd(e.vars, hashfn(name, len e.vars), ref Var(name, envstringtoval(val), 0));
+ }
+ }
+ if (pushed != nil)
+ e.flags = pushed.flags;
+ return e;
+}
+
+copybuiltins(b: ref Builtins): ref Builtins
+{
+ nb := ref Builtins(array[b.n] of (string, list of Shellbuiltin), b.n);
+ nb.ba[0:] = b.ba[0:b.n];
+ return nb;
+}
+
+findbuiltin(b: ref Builtins, name: string): (int, list of Shellbuiltin)
+{
+ lo := 0;
+ hi := b.n - 1;
+ while (lo <= hi) {
+ mid := (lo + hi) / 2;
+ (bname, bmod) := b.ba[mid];
+ if (name < bname)
+ hi = mid - 1;
+ else if (name > bname)
+ lo = mid + 1;
+ else
+ return (mid, bmod);
+ }
+ return (lo, nil);
+}
+
+removebuiltin(b: ref Builtins, name: string, mod: Shellbuiltin)
+{
+ (n, bmods) := findbuiltin(b, name);
+ if (bmods == nil)
+ return;
+ if (hd bmods == mod) {
+ if (tl bmods != nil)
+ b.ba[n] = (name, tl bmods);
+ else {
+ b.ba[n:] = b.ba[n+1:b.n];
+ b.ba[--b.n] = (nil, nil);
+ }
+ }
+}
+
+addbuiltin(b: ref Builtins, name: string, mod: Shellbuiltin)
+{
+ if (mod == nil || (name == "builtin" && mod != myselfbuiltin))
+ return;
+ (n, bmods) := findbuiltin(b, name);
+ if (bmods != nil) {
+ if (hd bmods == myselfbuiltin)
+ b.ba[n] = (name, mod :: bmods);
+ else
+ b.ba[n] = (name, mod :: nil);
+ } else {
+ if (b.n == len b.ba) {
+ nb := array[b.n + 10] of (string, list of Shellbuiltin);
+ nb[0:] = b.ba[0:b.n];
+ b.ba = nb;
+ }
+ b.ba[n+1:] = b.ba[n:b.n];
+ b.ba[n] = (name, mod :: nil);
+ b.n++;
+ }
+}
+
+removebuiltinmod(b: ref Builtins, mod: Shellbuiltin)
+{
+ j := 0;
+ for (i := 0; i < b.n; i++) {
+ (name, bmods) := b.ba[i];
+ if (hd bmods == mod)
+ bmods = tl bmods;
+ if (bmods != nil)
+ b.ba[j++] = (name, bmods);
+ }
+ b.n = j;
+ for (; j < i; j++)
+ b.ba[j] = (nil, nil);
+}
+
+export(e: ref Localenv)
+{
+ if (env == nil)
+ return;
+ if (e.pushed != nil)
+ export(e.pushed);
+
+ for (i := 0; i < len e.vars; i++) {
+ for (vl := e.vars[i]; vl != nil; vl = tl vl) {
+ v := hd vl;
+ # a bit inefficient: a local variable will get several putenvs.
+ if ((v.flags & Var.CHANGED) && !(v.flags & Var.NOEXPORT)) {
+ setenv(v.name, v.val);
+ v.flags &= ~Var.CHANGED;
+ }
+ }
+ }
+}
+
+noexport(name: string): int
+{
+ case name {
+ "0" or "*" or "status" => return 1;
+ }
+ return 0;
+}
+
+index(val: list of ref Listnode, k: int): list of ref Listnode
+{
+ for (; k > 0 && val != nil; k--)
+ val = tl val;
+ if (val != nil)
+ val = hd val :: nil;
+ return val;
+}
+
+getenv(name: string): list of ref Listnode
+{
+ if (env == nil)
+ return nil;
+ return envstringtoval(env->getenv(name));
+}
+
+envstringtoval(v: string): list of ref Listnode
+{
+ return stringlist2list(str->unquoted(v));
+}
+
+XXXenvstringtoval(v: string): list of ref Listnode
+{
+ if (len v == 0)
+ return nil;
+ start := len v;
+ val: list of ref Listnode;
+ for (i := start - 1; i >= 0; i--) {
+ if (v[i] == ENVSEP) {
+ val = ref Listnode(nil, v[i+1:start]) :: val;
+ start = i;
+ }
+ }
+ return ref Listnode(nil, v[0:start]) :: val;
+}
+
+setenv(name: string, val: list of ref Listnode)
+{
+ if (env == nil)
+ return;
+ env->setenv(name, quoted(val, 1));
+}
+
+
+containswildchar(s: string): int
+{
+ # try and avoid being fooled by GLOB characters in quoted
+ # text. we'll only be fooled if the GLOB char is followed
+ # by a wildcard char, or another GLOB.
+ for (i := 0; i < len s; i++) {
+ if (s[i] == GLOB && i < len s - 1) {
+ case s[i+1] {
+ '*' or '[' or '?' or GLOB =>
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+patquote(word: string): string
+{
+ outword := "";
+ for (i := 0; i < len word; i++) {
+ case word[i] {
+ '[' or '*' or '?' or '\\' =>
+ outword[len outword] = '\\';
+ GLOB =>
+ i++;
+ if (i >= len word)
+ return outword;
+ }
+ outword[len outword] = word[i];
+ }
+ return outword;
+}
+
+deglob(s: string): string
+{
+ j := 0;
+ for (i := 0; i < len s; i++) {
+ if (s[i] != GLOB) {
+ if (i != j) # a worthy optimisation???
+ s[j] = s[i];
+ j++;
+ }
+ }
+ if (i == j)
+ return s;
+ return s[0:j];
+}
+
+glob(nl: list of ref Listnode): list of ref Listnode
+{
+ new: list of ref Listnode;
+ while (nl != nil) {
+ n := hd nl;
+ if (containswildchar(n.word)) {
+ qword := patquote(n.word);
+ files := filepat->expand(qword);
+ if (files == nil)
+ files = deglob(n.word) :: nil;
+ while (files != nil) {
+ new = ref Listnode(nil, hd files) :: new;
+ files = tl files;
+ }
+ } else
+ new = n :: new;
+ nl = tl nl;
+ }
+ ret := revlist(new);
+ return ret;
+}
+
+
+list2stringlist(nl: list of ref Listnode): list of string
+{
+ ret: list of string = nil;
+
+ while (nl != nil) {
+ newel: string;
+ el := hd nl;
+ if (el.word != nil || el.cmd == nil)
+ newel = el.word;
+ else
+ el.word = newel = cmd2string(el.cmd);
+ ret = newel::ret;
+ nl = tl nl;
+ }
+
+ sl := revstringlist(ret);
+ return sl;
+}
+
+stringlist2list(sl: list of string): list of ref Listnode
+{
+ ret: list of ref Listnode;
+
+ while (sl != nil) {
+ ret = ref Listnode(nil, hd sl) :: ret;
+ sl = tl sl;
+ }
+ return revlist(ret);
+}
+
+revstringlist(l: list of string): list of string
+{
+ t: list of string;
+
+ while(l != nil) {
+ t = hd l :: t;
+ l = tl l;
+ }
+ return t;
+}
+
+revlist(l: list of ref Listnode): list of ref Listnode
+{
+ t: list of ref Listnode;
+
+ while(l != nil) {
+ t = hd l :: t;
+ l = tl l;
+ }
+ return t;
+}
+
+
+fdassignstr(isassign: int, redir: ref Redir): string
+{
+ l: string = nil;
+ if (redir.fd1 >= 0)
+ l = string redir.fd1;
+
+ if (isassign) {
+ r: string = nil;
+ if (redir.fd2 >= 0)
+ r = string redir.fd2;
+ return "[" + l + "=" + r + "]";
+ }
+ return "[" + l + "]";
+}
+
+redirstr(rtype: int): string
+{
+ case rtype {
+ * or
+ Sys->OREAD => return "<";
+ Sys->OWRITE => return ">";
+ Sys->OWRITE|OAPPEND => return ">>";
+ Sys->ORDWR => return "<>";
+ }
+}
+
+cmd2string(n: ref Node): string
+{
+ if (n == nil)
+ return "";
+
+ s: string;
+ case n.ntype {
+ n_BLOCK => s = "{" + cmd2string(n.left) + "}";
+ n_VAR => s = "$" + cmd2string(n.left);
+ # XXX can this ever occur?
+ if (n.right != nil)
+ s += "(" + cmd2string(n.right) + ")";
+ n_SQUASH => s = "$\"" + cmd2string(n.left);
+ n_COUNT => s = "$#" + cmd2string(n.left);
+ n_BQ => s = "`" + cmd2string(n.left);
+ n_BQ2 => s = "\"" + cmd2string(n.left);
+ n_REDIR => s = redirstr(n.redir.rtype);
+ if (n.redir.fd1 != -1)
+ s += fdassignstr(0, n.redir);
+ s += cmd2string(n.left);
+ n_DUP => s = redirstr(n.redir.rtype) + fdassignstr(1, n.redir);
+ n_LIST => s = "(" + cmd2string(n.left) + ")";
+ n_SEQ => s = cmd2string(n.left) + ";" + cmd2string(n.right);
+ n_NOWAIT => s = cmd2string(n.left) + "&";
+ n_CONCAT => s = cmd2string(n.left) + "^" + cmd2string(n.right);
+ n_PIPE => s = cmd2string(n.left) + "|";
+ if (n.redir != nil && (n.redir.fd1 != -1 || n.redir.fd2 != -1))
+ s += fdassignstr(n.redir.fd2 != -1, n.redir);
+ s += cmd2string(n.right);
+ n_ASSIGN => s = cmd2string(n.left) + "=" + cmd2string(n.right);
+ n_LOCAL => s = cmd2string(n.left) + ":=" + cmd2string(n.right);
+ n_ADJ => s = cmd2string(n.left) + " " + cmd2string(n.right);
+ n_WORD => s = quote(n.word, 1);
+ * => s = sys->sprint("unknown%d", n.ntype);
+ }
+ return s;
+}
+
+quote(s: string, glob: int): string
+{
+ needquote := 0;
+ t := "";
+ for (i := 0; i < len s; i++) {
+ case s[i] {
+ '{' or '}' or '(' or ')' or '`' or '&' or ';' or '=' or '>' or '<' or '#' or
+ '|' or '*' or '[' or '?' or '$' or '^' or ' ' or '\t' or '\n' or '\r' =>
+ needquote = 1;
+ '\'' =>
+ t[len t] = '\'';
+ needquote = 1;
+ GLOB =>
+ if (glob) {
+ if (i < len s - 1)
+ i++;
+ }
+ }
+ t[len t] = s[i];
+ }
+ if (needquote || t == nil)
+ t = "'" + t + "'";
+ return t;
+}
+
+squash(l: list of string, sep: string): string
+{
+ if (l == nil)
+ return nil;
+ s := hd l;
+ for (l = tl l; l != nil; l = tl l)
+ s += sep + hd l;
+ return s;
+}
+
+debug(s: string)
+{
+ if (DEBUG) sys->fprint(stderr(), "%s\n", string sys->pctl(0, nil) + ": " + s);
+}
+
+
+initbuiltin(c: ref Context, nil: Sh): string
+{
+ names := array[] of {"load", "unload", "loaded", "builtin", "syncenv", "whatis", "run", "exit", "@"};
+ for (i := 0; i < len names; i++)
+ c.addbuiltin(names[i], myselfbuiltin);
+ c.addsbuiltin("loaded", myselfbuiltin);
+ c.addsbuiltin("quote", myselfbuiltin);
+ c.addsbuiltin("bquote", myselfbuiltin);
+ c.addsbuiltin("unquote", myselfbuiltin);
+ c.addsbuiltin("builtin", myselfbuiltin);
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+runsbuiltin(ctxt: ref Context, nil: Sh, argv: list of ref Listnode): list of ref Listnode
+{
+ case (hd argv).word {
+ "loaded" => return sbuiltin_loaded(ctxt, argv);
+ "bquote" => return sbuiltin_quote(ctxt, argv, 0);
+ "quote" => return sbuiltin_quote(ctxt, argv, 1);
+ "unquote" => return sbuiltin_unquote(ctxt, argv);
+ "builtin" => return sbuiltin_builtin(ctxt, argv);
+ }
+ return nil;
+}
+
+runbuiltin(ctxt: ref Context, nil: Sh, args: list of ref Listnode, lseq: int): string
+{
+ status := "";
+ name := (hd args).word;
+ case name {
+ "load" => status = builtin_load(ctxt, args, lseq);
+ "loaded" => status = builtin_loaded(ctxt, args, lseq);
+ "unload" => status = builtin_unload(ctxt, args, lseq);
+ "builtin" => status = builtin_builtin(ctxt, args, lseq);
+ "whatis" => status = builtin_whatis(ctxt, args, lseq);
+ "run" => status = builtin_run(ctxt, args, lseq);
+ "exit" => status = builtin_exit(ctxt, args, lseq);
+ "syncenv" => export(ctxt.env.localenv);
+ "@" => status = builtin_subsh(ctxt, args, lseq);
+ }
+ return status;
+}
+
+sbuiltin_loaded(ctxt: ref Context, nil: list of ref Listnode): list of ref Listnode
+{
+ v: list of ref Listnode;
+ for (bl := ctxt.env.bmods; bl != nil; bl = tl bl) {
+ (name, nil) := hd bl;
+ v = ref Listnode(nil, name) :: v;
+ }
+ return v;
+}
+
+sbuiltin_quote(nil: ref Context, argv: list of ref Listnode, quoteblocks: int): list of ref Listnode
+{
+ return ref Listnode(nil, quoted(tl argv, quoteblocks)) :: nil;
+}
+
+sbuiltin_builtin(ctxt: ref Context, args: list of ref Listnode): list of ref Listnode
+{
+ if (args == nil || tl args == nil)
+ builtinusage(ctxt, "builtin command [args ...]");
+ name := (hd tl args).word;
+ (nil, mods) := findbuiltin(ctxt.env.sbuiltins, name);
+ for (; mods != nil; mods = tl mods)
+ if (hd mods == myselfbuiltin)
+ return (hd mods)->runsbuiltin(ctxt, myself, tl args);
+ ctxt.fail("builtin not found", sys->sprint("sh: builtin %s not found", name));
+ return nil;
+}
+
+sbuiltin_unquote(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ argv = tl argv;
+ if (argv == nil || tl argv != nil)
+ builtinusage(ctxt, "unquote arg");
+
+ arg := (hd argv).word;
+ if (arg == nil && (hd argv).cmd != nil)
+ arg = cmd2string((hd argv).cmd);
+ return stringlist2list(str->unquoted(arg));
+}
+
+getself(): Shellbuiltin
+{
+ return myselfbuiltin;
+}
+
+builtinusage(ctxt: ref Context, s: string)
+{
+ ctxt.fail("usage", "sh: usage: " + s);
+}
+
+builtin_exit(nil: ref Context, nil: list of ref Listnode, nil: int): string
+{
+ # XXX using this primitive can cause
+ # environment stack not to be popped properly.
+ exit;
+}
+
+builtin_subsh(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args == nil)
+ return nil;
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 0, tl args, ref Redirlist, startchan);
+ (exepid, exprop) := <-startchan;
+ status := waitfor(ctxt, exepid :: nil);
+ if (exprop.name != nil)
+ raise exprop.name;
+ return status;
+}
+
+builtin_loaded(ctxt: ref Context, nil: list of ref Listnode, nil: int): string
+{
+ b := ctxt.env.builtins;
+ for (i := 0; i < b.n; i++) {
+ (name, bmods) := b.ba[i];
+ sys->print("%s\t%s\n", name, modname(ctxt, hd bmods));
+ }
+ b = ctxt.env.sbuiltins;
+ for (i = 0; i < b.n; i++) {
+ (name, bmods) := b.ba[i];
+ sys->print("${%s}\t%s\n", name, modname(ctxt, hd bmods));
+ }
+ return nil;
+}
+
+builtin_load(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args == nil || (hd tl args).word == nil)
+ builtinusage(ctxt, "load path...");
+ args = tl args;
+ path := (hd args).word;
+ if (args == nil)
+ builtinusage(ctxt, "load path...");
+ status := "";
+ for (; args != nil; args = tl args) {
+ s := loadmodule(ctxt, (hd args).word);
+ if (s != nil)
+ raise "fail:" + s;
+ }
+ return nil;
+}
+
+builtin_unload(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args == nil)
+ builtinusage(ctxt, "unload path...");
+ status := "";
+ for (args = tl args; args != nil; args = tl args)
+ if ((s := unloadmodule(ctxt, (hd args).word)) != nil)
+ status = s;
+ return status;
+}
+
+builtin_run(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args == nil || (hd tl args).word == nil)
+ builtinusage(ctxt, "run path");
+ ctxt.push();
+ {
+ ctxt.setoptions(ctxt.INTERACTIVE, 0);
+ runscript(ctxt, (hd tl args).word, tl tl args, 1);
+ ctxt.pop();
+ return nil;
+ } exception e {
+ "fail:*" =>
+ ctxt.pop();
+ return e[5:];
+ }
+}
+
+builtin_whatis(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (len args < 2)
+ builtinusage(ctxt, "whatis name ...");
+ err := "";
+ for (args = tl args; args != nil; args = tl args)
+ if ((e := whatisit(ctxt, hd args)) != nil)
+ err = e;
+ return err;
+}
+
+whatisit(ctxt: ref Context, el: ref Listnode): string
+{
+ if (el.cmd != nil) {
+ sys->print("%s\n", cmd2string(el.cmd));
+ return nil;
+ }
+ found := 0;
+ name := el.word;
+ if (name != nil && name[0] == '{') { #}
+ sys->print("%s\n", name);
+ return nil;;
+ }
+ if (name == nil)
+ return nil; # XXX questionable
+ w: string;
+ val := ctxt.get(name);
+ if (val != nil) {
+ found++;
+ w += sys->sprint("%s=%s\n", quote(name, 0), quoted(val, 0));
+ }
+ (nil, mods) := findbuiltin(ctxt.env.sbuiltins, name);
+ if (mods != nil) {
+ mod := hd mods;
+ if (mod == myselfbuiltin)
+ w += "${builtin " + name + "}\n";
+ else {
+ mw := mod->whatis(ctxt, myself, name, Shellbuiltin->SBUILTIN);
+ if (mw == nil)
+ mw = "${" + name + "}";
+ w += "load " + modname(ctxt, mod) + "; " + mw + "\n";
+ }
+ found++;
+ }
+ (nil, mods) = findbuiltin(ctxt.env.builtins, name);
+ if (mods != nil) {
+ mod := hd mods;
+ if (mod == myselfbuiltin)
+ sys->print("builtin %s\n", name);
+ else {
+ mw := mod->whatis(ctxt, myself, name, Shellbuiltin->BUILTIN);
+ if (mw == nil)
+ mw = name;
+ w += "load " + modname(ctxt, mod) + "; " + mw + "\n";
+ }
+ found++;
+ } else {
+ disfile := 0;
+ if (len name >= 4 && name[len name-4:] == ".dis")
+ disfile = 1;
+ pathlist: list of string;
+ if (len name >= 2 && (name[0] == '/' || name[0:2] == "./"))
+ pathlist = list of {""};
+ else if ((pl := ctxt.get("path")) != nil)
+ pathlist = list2stringlist(pl);
+ else
+ pathlist = list of {"/dis", "."};
+
+ foundpath := "";
+ while (pathlist != nil) {
+ path: string;
+ if (hd pathlist != "")
+ path = hd pathlist + "/" + name;
+ else
+ path = name;
+ if (!disfile && (fd := sys->open(path, Sys->OREAD)) != nil) {
+ if (executable(sys->fstat(fd), 8r111)) {
+ foundpath = path;
+ break;
+ }
+ }
+ if (!disfile)
+ path += ".dis";
+ if (executable(sys->stat(path), 8r444)) {
+ foundpath = path;
+ break;
+ }
+ pathlist = tl pathlist;
+ }
+ if (foundpath != nil)
+ w += foundpath + "\n";
+ }
+ for (bmods := ctxt.env.bmods; bmods != nil; bmods = tl bmods) {
+ (modname, mod) := hd bmods;
+ if ((mw := mod->whatis(ctxt, myself, name, Shellbuiltin->OTHER)) != nil)
+ w += "load " + modname + "; " + mw + "\n";
+ }
+ if (w == nil) {
+ sys->fprint(stderr(), "%s: not found\n", name);
+ return "not found";
+ }
+ sys->print("%s", w);
+ return nil;
+}
+
+builtin_builtin(ctxt: ref Context, args: list of ref Listnode, last: int): string
+{
+ if (len args < 2)
+ builtinusage(ctxt, "builtin command [args ...]");
+ name := (hd tl args).word;
+ if (name == nil || name[0] == '{') {
+ diagnostic(ctxt, name + " not found");
+ return "not found";
+ }
+ (nil, mods) := findbuiltin(ctxt.env.builtins, name);
+ for (; mods != nil; mods = tl mods)
+ if (hd mods == myselfbuiltin)
+ return (hd mods)->runbuiltin(ctxt, myself, tl args, last);
+ if (ctxt.options() & ctxt.EXECPRINT)
+ sys->fprint(stderr(), "%s\n", quoted(tl args, 0));
+ return runexternal(ctxt, tl args, last);
+}
+
+modname(ctxt: ref Context, mod: Shellbuiltin): string
+{
+ for (ml := ctxt.env.bmods; ml != nil; ml = tl ml) {
+ (bname, bmod) := hd ml;
+ if (bmod == mod)
+ return bname;
+ }
+ return "builtin";
+}
+
+loadmodule(ctxt: ref Context, name: string): string
+{
+ # avoid loading the same module twice (it's convenient
+ # to have load be a null-op if the module required is already loaded)
+ for (bl := ctxt.env.bmods; bl != nil; bl = tl bl) {
+ (bname, nil) := hd bl;
+ if (bname == name)
+ return nil;
+ }
+ path := name;
+ if (len path < 4 || path[len path-4:] != ".dis")
+ path += ".dis";
+ if (path[0] != '/' && path[0:2] != "./")
+ path = BUILTINPATH + "/" + path;
+ mod := load Shellbuiltin path;
+ if (mod == nil) {
+ diagnostic(ctxt, sys->sprint("load: cannot load %s: %r", path));
+ return "bad module";
+ }
+ s := mod->initbuiltin(ctxt, myself);
+ ctxt.env.bmods = (name, mod->getself()) :: ctxt.env.bmods;
+ if (s != nil) {
+ unloadmodule(ctxt, name);
+ diagnostic(ctxt, "load: module init failed: " + s);
+ }
+ return s;
+}
+
+unloadmodule(ctxt: ref Context, name: string): string
+{
+ bl: list of (string, Shellbuiltin);
+ mod: Shellbuiltin;
+ for (cl := ctxt.env.bmods; cl != nil; cl = tl cl) {
+ (bname, bmod) := hd cl;
+ if (bname == name)
+ mod = bmod;
+ else
+ bl = hd cl :: bl;
+ }
+ if (mod == nil) {
+ diagnostic(ctxt, sys->sprint("module %s not found", name));
+ return "not found";
+ }
+ for (ctxt.env.bmods = nil; bl != nil; bl = tl bl)
+ ctxt.env.bmods = hd bl :: ctxt.env.bmods;
+ removebuiltinmod(ctxt.env.builtins, mod);
+ removebuiltinmod(ctxt.env.sbuiltins, mod);
+ return nil;
+}
+
+executable(s: (int, Sys->Dir), mode: int): int
+{
+ (ok, info) := s;
+ return ok != -1 && (info.mode & Sys->DMDIR) == 0
+ && (info.mode & mode) != 0;
+}
+
+quoted(val: list of ref Listnode, quoteblocks: int): string
+{
+ s := "";
+ for (; val != nil; val = tl val) {
+ el := hd val;
+ if (el.cmd == nil || (quoteblocks && el.word != nil))
+ s += quote(el.word, 0);
+ else {
+ cmd := cmd2string(el.cmd);
+ if (quoteblocks)
+ cmd = quote(cmd, 0);
+ s += cmd;
+ }
+ if (tl val != nil)
+ s[len s] = ' ';
+ }
+ return s;
+}
+
+setstatus(ctxt: ref Context, val: string): string
+{
+ ctxt.setlocal("status", ref Listnode(nil, val) :: nil);
+ return val;
+}
+
+
+doparse(l: ref YYLEX, prompt: string, showline: int): (ref Node, string)
+{
+ l.prompt = prompt;
+ l.err = nil;
+ l.lval.node = nil;
+ yyparse(l);
+ l.lastnl = 0; # don't print secondary prompt next time
+ if (l.err != nil) {
+ s: string;
+ if (l.err == nil)
+ l.err = "unknown error";
+ if (l.errline > 0 && showline)
+ s = sys->sprint("%s:%d: %s", l.path, l.errline, l.err);
+ else
+ s = l.path + ": parse error: " + l.err;
+ return (nil, s);
+ }
+ return (l.lval.node, nil);
+}
+
+blanklex: YYLEX; # for hassle free zero initialisation
+
+YYLEX.initstring(s: string): ref YYLEX
+{
+ ret := ref blanklex;
+ ret.s = s;
+ ret.path="internal";
+ ret.strpos = 0;
+ return ret;
+}
+
+YYLEX.initfile(fd: ref Sys->FD, path: string): ref YYLEX
+{
+ lex := ref blanklex;
+ lex.f = bufio->fopen(fd, bufio->OREAD);
+ lex.path = path;
+ lex.cbuf = array[2] of int; # number of characters of pushback
+ lex.linenum = 1;
+ lex.prompt = "";
+ return lex;
+}
+
+YYLEX.error(l: self ref YYLEX, s: string)
+{
+ if (l.err == nil) {
+ l.err = s;
+ l.errline = l.linenum;
+ }
+}
+
+NOTOKEN: con -1;
+
+YYLEX.lex(l: self ref YYLEX): int
+{
+ # the following are allowed a free caret:
+ # $, word and quoted word;
+ # also, allowed chrs in unquoted word following dollar are [a-zA-Z0-9*_]
+ endword := 0;
+ wasdollar := 0;
+ tok := NOTOKEN;
+ while (tok == NOTOKEN) {
+ case c := l.getc() {
+ l.EOF =>
+ tok = END;
+ '\n' =>
+ tok = '\n';
+ '\r' or '\t' or ' ' =>
+ ;
+ '#' =>
+ while ((c = l.getc()) != '\n' && c != l.EOF)
+ ;
+ l.ungetc();
+ ';' => tok = ';';
+ '&' =>
+ c = l.getc();
+ if(c == '&')
+ tok = ANDAND;
+ else{
+ l.ungetc();
+ tok = '&';
+ }
+ '^' => tok = '^';
+ '{' => tok = '{';
+ '}' => tok = '}';
+ ')' => tok = ')';
+ '(' => tok = '(';
+ '=' => (tok, l.lval.optype) = ('=', n_ASSIGN);
+ '$' =>
+ if (l.atendword) {
+ l.ungetc();
+ tok = '^';
+ break;
+ }
+ case (c = l.getc()) {
+ '#' =>
+ l.lval.optype = n_COUNT;
+ '"' =>
+ l.lval.optype = n_SQUASH;
+ * =>
+ l.ungetc();
+ l.lval.optype = n_VAR;
+ }
+ tok = OP;
+ wasdollar = 1;
+ '"' or '`'=>
+ if (l.atendword) {
+ tok = '^';
+ l.ungetc();
+ break;
+ }
+ tok = OP;
+ if (c == '"')
+ l.lval.optype = n_BQ2;
+ else
+ l.lval.optype = n_BQ;
+ '>' or '<' =>
+ rtype: int;
+ nc := l.getc();
+ if (nc == '>') {
+ if (c == '>')
+ rtype = Sys->OWRITE | OAPPEND;
+ else
+ rtype = Sys->ORDWR;
+ nc = l.getc();
+ } else if (c == '>')
+ rtype = Sys->OWRITE;
+ else
+ rtype = Sys->OREAD;
+ tok = REDIR;
+ if (nc == '[') {
+ (tok, l.lval.redir) = readfdassign(l);
+ if (tok == ERROR)
+ (l.err, l.errline) = ("syntax error in redirection", l.linenum);
+ } else {
+ l.ungetc();
+ l.lval.redir = ref Redir(-1, -1, -1);
+ }
+ if (l.lval.redir != nil)
+ l.lval.redir.rtype = rtype;
+ '|' =>
+ tok = '|';
+ l.lval.redir = nil;
+ if ((c = l.getc()) == '[') {
+ (tok, l.lval.redir) = readfdassign(l);
+ if (tok == ERROR) {
+ (l.err, l.errline) = ("syntax error in pipe redirection", l.linenum);
+ return tok;
+ }
+ tok = '|';
+ } else if(c == '|')
+ tok = OROR;
+ else
+ l.ungetc();
+
+ '\'' =>
+ if (l.atendword) {
+ l.ungetc();
+ tok = '^';
+ break;
+ }
+ startline := l.linenum;
+ s := "";
+ for(;;) {
+ while ((nc := l.getc()) != '\'' && nc != l.EOF)
+ s[len s] = nc;
+ if (nc == l.EOF) {
+ (l.err, l.errline) = ("unterminated string literal", startline);
+ return ERROR;
+ }
+ if (l.getc() != '\'') {
+ l.ungetc();
+ break;
+ }
+ s[len s] = '\''; # 'xxx''yyy' becomes WORD(xxx'yyy)
+ }
+ l.lval.word = s;
+ tok = WORD;
+ endword = 1;
+
+ * =>
+ if (c == ':') {
+ if (l.getc() == '=') {
+ tok = '=';
+ l.lval.optype = n_LOCAL;
+ break;
+ }
+ l.ungetc();
+ }
+ if (l.atendword) {
+ l.ungetc();
+ tok = '^';
+ break;
+ }
+ allowed: string;
+ if (l.wasdollar)
+ allowed = "a-zA-Z0-9*_";
+ else
+ allowed = "^\n \t\r|$'#<>;^(){}`&=\"";
+ word := "";
+ loop: do {
+ case c {
+ '*' or '?' or '[' or GLOB =>
+ word[len word] = GLOB;
+ ':' =>
+ nc := l.getc();
+ l.ungetc();
+ if (nc == '=')
+ break loop;
+ }
+ word[len word] = c;
+ } while ((c = l.getc()) != l.EOF && str->in(c, allowed));
+ l.ungetc();
+ l.lval.word = word;
+ tok = WORD;
+ endword = 1;
+ }
+ l.atendword = endword;
+ l.wasdollar = wasdollar;
+ }
+ return tok;
+}
+
+tokstr(t: int): string
+{
+ s: string;
+ case t {
+ '\n' => s = "'\\n'";
+ 33 to 127 => s = sprint("'%c'", t);
+ DUP=> s = "DUP";
+ REDIR =>s = "REDIR";
+ WORD => s = "WORD";
+ OP => s = "OP";
+ END => s = "END";
+ ERROR=> s = "ERROR";
+ * =>
+ s = "<unknowntok"+ string t + ">";
+ }
+ return s;
+}
+
+YYLEX.ungetc(lex: self ref YYLEX)
+{
+ lex.strpos--;
+ if (lex.f != nil) {
+ lex.ncbuf++;
+ if (lex.strpos < 0)
+ lex.strpos = len lex.cbuf - 1;
+ }
+}
+
+YYLEX.getc(lex: self ref YYLEX): int
+{
+ if (lex.eof) # EOF sticks
+ return lex.EOF;
+ c: int;
+ if (lex.f != nil) {
+ if (lex.ncbuf > 0) {
+ c = lex.cbuf[lex.strpos++];
+ if (lex.strpos >= len lex.cbuf)
+ lex.strpos = 0;
+ lex.ncbuf--;
+ } else {
+ if (lex.lastnl && lex.prompt != nil)
+ sys->fprint(stderr(), "%s", lex.prompt);
+ c = bufio->lex.f.getc();
+ if (c == bufio->ERROR || c == bufio->EOF) {
+ lex.eof = 1;
+ c = lex.EOF;
+ } else if (c == '\n')
+ lex.linenum++;
+ lex.lastnl = (c == '\n');
+ lex.cbuf[lex.strpos++] = c;
+ if (lex.strpos >= len lex.cbuf)
+ lex.strpos = 0;
+ }
+ } else {
+ if (lex.strpos >= len lex.s) {
+ lex.eof = 1;
+ c = lex.EOF;
+ } else
+ c = lex.s[lex.strpos++];
+ }
+ return c;
+}
+
+readnum(lex: ref YYLEX): int
+{
+ sum := nc := 0;
+ while ((c := lex.getc()) >= '0' && c <= '9') {
+ sum = (sum * 10) + (c - '0');
+ nc++;
+ }
+ lex.ungetc();
+ if (nc == 0)
+ return -1;
+ return sum;
+}
+
+readfdassign(lex: ref YYLEX): (int, ref Redir)
+{
+ n1 := readnum(lex);
+ if ((c := lex.getc()) != '=') {
+ if (c == ']')
+ return (REDIR, ref Redir(-1, n1, -1));
+
+ return (ERROR, nil);
+ }
+ n2 := readnum(lex);
+ if (lex.getc() != ']')
+ return (ERROR, nil);
+ return (DUP, ref Redir(-1, n1, n2));
+}
+
+mkseq(left, right: ref Node): ref Node
+{
+ if (left != nil && right != nil)
+ return mk(n_SEQ, left, right);
+ else if (left == nil)
+ return right;
+ return left;
+}
+
+mk(ntype: int, left, right: ref Node): ref Node
+{
+ return ref Node(ntype, left, right, nil, nil);
+}
+
+stderr(): ref Sys->FD
+{
+ return sys->fildes(2);
+}
+yyexca := array[] of {-1, 0,
+ 8, 17,
+ 10, 17,
+ 11, 17,
+ 12, 17,
+ 14, 17,
+ 15, 17,
+ 16, 17,
+ -2, 0,
+-1, 1,
+ 1, -1,
+ -2, 0,
+};
+YYNPROD: con 45;
+YYPRIVATE: con 57344;
+yytoknames: array of string;
+yystates: array of string;
+yydebug: con 0;
+YYLAST: con 93;
+yyact := array[] of {
+ 12, 10, 15, 4, 5, 40, 8, 11, 9, 7,
+ 30, 31, 54, 6, 50, 35, 34, 32, 33, 21,
+ 36, 38, 34, 41, 43, 22, 29, 3, 28, 13,
+ 14, 16, 17, 20, 37, 42, 1, 23, 45, 51,
+ 44, 47, 48, 18, 39, 19, 41, 43, 56, 30,
+ 31, 46, 58, 57, 59, 60, 49, 13, 14, 16,
+ 17, 53, 13, 14, 16, 17, 2, 52, 0, 16,
+ 17, 18, 27, 19, 16, 17, 18, 52, 19, 0,
+ 26, 18, 0, 19, 24, 25, 18, 26, 19, 0,
+ 55, 24, 25,
+};
+yypact := array[] of {
+ 25,-1000, 11, 11, 69, 58, 18, 14,-1000, 58,
+ 58,-1000, 5,-1000, 68,-1000,-1000, 68,-1000, 58,
+-1000,-1000,-1000,-1000,-1000,-1000, 58,-1000, 58,-1000,
+ -1,-1000,-1000, 68,-1000, -1,-1000, -5, 63,-1000,
+ -9, 76, 58,-1000, 18, 14, 53,-1000, 58, 63,
+-1000, -1,-1000, 53,-1000,-1000,-1000,-1000,-1000, -1,
+-1000,
+};
+yypgo := array[] of {
+ 0, 1, 0, 44, 8, 6, 36, 7, 35, 4,
+ 9, 2, 66, 5, 34, 13, 3, 33, 21,
+};
+yyr1 := array[] of {
+ 0, 6, 6, 17, 17, 12, 12, 13, 13, 9,
+ 9, 8, 8, 16, 16, 15, 15, 10, 10, 10,
+ 5, 5, 5, 5, 7, 7, 7, 1, 1, 4,
+ 4, 4, 14, 14, 3, 3, 3, 2, 2, 11,
+ 11, 11, 11, 18, 18,
+};
+yyr2 := array[] of {
+ 0, 2, 2, 1, 1, 1, 2, 1, 2, 2,
+ 2, 1, 2, 1, 3, 1, 3, 0, 1, 4,
+ 1, 2, 1, 1, 3, 3, 2, 1, 2, 1,
+ 2, 2, 1, 2, 2, 3, 3, 1, 4, 1,
+ 2, 3, 3, 0, 2,
+};
+yychk := array[] of {
+-1000, -6, -12, 2, -16, -9, -15, -10, -5, -4,
+ -1, -7, -2, 4, 5, -11, 6, 7, 18, 20,
+ -17, 8, 14, -17, 15, 16, 11, -12, 10, 12,
+ -2, -1, -5, 13, 17, -2, -11, -14, -18, -3,
+ -13, -16, -8, -9, -15, -10, -18, -7, -4, -18,
+ 19, -2, 14, -18, 21, 14, -13, -5, -11, -2,
+ -1,
+};
+yydef := array[] of {
+ -2, -2, 0, 0, 5, 17, 13, 15, 18, 20,
+ 22, 23, 29, 27, 0, 37, 39, 0, 43, 17,
+ 1, 3, 4, 2, 9, 10, 17, 6, 17, 43,
+ 30, 31, 21, 26, 43, 28, 40, 0, 32, 43,
+ 0, 7, 17, 11, 14, 16, 0, 24, 25, 0,
+ 41, 34, 44, 33, 42, 12, 8, 19, 38, 35,
+ 36,
+};
+yytok1 := array[] of {
+ 1, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 14, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 16, 3,
+ 18, 19, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 15,
+ 3, 13, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 17, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
+ 3, 3, 3, 20, 12, 21,
+};
+yytok2 := array[] of {
+ 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
+};
+yytok3 := array[] of {
+ 0
+};
+
+YYSys: module
+{
+ FD: adt
+ {
+ fd: int;
+ };
+ fildes: fn(fd: int): ref FD;
+ fprint: fn(fd: ref FD, s: string, *): int;
+};
+
+yysys: YYSys;
+yystderr: ref YYSys->FD;
+
+YYFLAG: con -1000;
+
+
+yytokname(yyc: int): string
+{
+ if(yyc > 0 && yyc <= len yytoknames && yytoknames[yyc-1] != nil)
+ return yytoknames[yyc-1];
+ return "<"+string yyc+">";
+}
+
+yystatname(yys: int): string
+{
+ if(yys >= 0 && yys < len yystates && yystates[yys] != nil)
+ return yystates[yys];
+ return "<"+string yys+">\n";
+}
+
+yylex1(yylex: ref YYLEX): int
+{
+ c : int;
+ yychar := yylex.lex();
+ if(yychar <= 0)
+ c = yytok1[0];
+ else if(yychar < len yytok1)
+ c = yytok1[yychar];
+ else if(yychar >= YYPRIVATE && yychar < YYPRIVATE+len yytok2)
+ c = yytok2[yychar-YYPRIVATE];
+ else{
+ n := len yytok3;
+ c = 0;
+ for(i := 0; i < n; i+=2) {
+ if(yytok3[i+0] == yychar) {
+ c = yytok3[i+1];
+ break;
+ }
+ }
+ if(c == 0)
+ c = yytok2[1]; # unknown char
+ }
+ if(yydebug >= 3)
+ yysys->fprint(yystderr, "lex %.4ux %s\n", yychar, yytokname(c));
+ return c;
+}
+
+YYS: adt
+{
+ yyv: YYSTYPE;
+ yys: int;
+};
+
+yyparse(yylex: ref YYLEX): int
+{
+ if(yydebug >= 1 && yysys == nil) {
+ yysys = load YYSys "$Sys";
+ yystderr = yysys->fildes(2);
+ }
+
+ yys := array[YYMAXDEPTH] of YYS;
+
+ yyval: YYSTYPE;
+ yystate := 0;
+ yychar := -1;
+ yynerrs := 0; # number of errors
+ yyerrflag := 0; # error recovery flag
+ yyp := -1;
+ yyn := 0;
+
+yystack:
+ for(;;){
+ # put a state and value onto the stack
+ if(yydebug >= 4)
+ yysys->fprint(yystderr, "char %s in %s", yytokname(yychar), yystatname(yystate));
+
+ yyp++;
+ if(yyp >= len yys)
+ yys = (array[len yys * 2] of YYS)[0:] = yys;
+ yys[yyp].yys = yystate;
+ yys[yyp].yyv = yyval;
+
+ for(;;){
+ yyn = yypact[yystate];
+ if(yyn > YYFLAG) { # simple state
+ if(yychar < 0)
+ yychar = yylex1(yylex);
+ yyn += yychar;
+ if(yyn >= 0 && yyn < YYLAST) {
+ yyn = yyact[yyn];
+ if(yychk[yyn] == yychar) { # valid shift
+ yychar = -1;
+ yyp++;
+ if(yyp >= len yys)
+ yys = (array[len yys * 2] of YYS)[0:] = yys;
+ yystate = yyn;
+ yys[yyp].yys = yystate;
+ yys[yyp].yyv = yylex.lval;
+ if(yyerrflag > 0)
+ yyerrflag--;
+ if(yydebug >= 4)
+ yysys->fprint(yystderr, "char %s in %s", yytokname(yychar), yystatname(yystate));
+ continue;
+ }
+ }
+ }
+
+ # default state action
+ yyn = yydef[yystate];
+ if(yyn == -2) {
+ if(yychar < 0)
+ yychar = yylex1(yylex);
+
+ # look through exception table
+ for(yyxi:=0;; yyxi+=2)
+ if(yyexca[yyxi] == -1 && yyexca[yyxi+1] == yystate)
+ break;
+ for(yyxi += 2;; yyxi += 2) {
+ yyn = yyexca[yyxi];
+ if(yyn < 0 || yyn == yychar)
+ break;
+ }
+ yyn = yyexca[yyxi+1];
+ if(yyn < 0){
+ yyn = 0;
+ break yystack;
+ }
+ }
+
+ if(yyn != 0)
+ break;
+
+ # error ... attempt to resume parsing
+ if(yyerrflag == 0) { # brand new error
+ yylex.error("syntax error");
+ yynerrs++;
+ if(yydebug >= 1) {
+ yysys->fprint(yystderr, "%s", yystatname(yystate));
+ yysys->fprint(yystderr, "saw %s\n", yytokname(yychar));
+ }
+ }
+
+ if(yyerrflag != 3) { # incompletely recovered error ... try again
+ yyerrflag = 3;
+
+ # find a state where "error" is a legal shift action
+ while(yyp >= 0) {
+ yyn = yypact[yys[yyp].yys] + YYERRCODE;
+ if(yyn >= 0 && yyn < YYLAST) {
+ yystate = yyact[yyn]; # simulate a shift of "error"
+ if(yychk[yystate] == YYERRCODE)
+ continue yystack;
+ }
+
+ # the current yyp has no shift onn "error", pop stack
+ if(yydebug >= 2)
+ yysys->fprint(yystderr, "error recovery pops state %d, uncovers %d\n",
+ yys[yyp].yys, yys[yyp-1].yys );
+ yyp--;
+ }
+ # there is no state on the stack with an error shift ... abort
+ yyn = 1;
+ break yystack;
+ }
+
+ # no shift yet; clobber input char
+ if(yydebug >= 2)
+ yysys->fprint(yystderr, "error recovery discards %s\n", yytokname(yychar));
+ if(yychar == YYEOFCODE) {
+ yyn = 1;
+ break yystack;
+ }
+ yychar = -1;
+ # try again in the same state
+ }
+
+ # reduction by production yyn
+ if(yydebug >= 2)
+ yysys->fprint(yystderr, "reduce %d in:\n\t%s", yyn, yystatname(yystate));
+
+ yypt := yyp;
+ yyp -= yyr2[yyn];
+ yym := yyn;
+
+ # consult goto table to find next state
+ yyn = yyr1[yyn];
+ yyg := yypgo[yyn];
+ yyj := yyg + yys[yyp].yys + 1;
+
+ if(yyj >= YYLAST || yychk[yystate=yyact[yyj]] != -yyn)
+ yystate = yyact[yyg];
+ case yym {
+
+1=>
+{yylex.lval.node = yys[yypt-1].yyv.node; return 0;}
+2=>
+{yylex.lval.node = nil; return 0;}
+5=>
+yyval.node = yys[yyp+1].yyv.node;
+6=>
+{yyval.node = mkseq(yys[yypt-1].yyv.node, yys[yypt-0].yyv.node); }
+7=>
+yyval.node = yys[yyp+1].yyv.node;
+8=>
+{yyval.node = mkseq(yys[yypt-1].yyv.node, yys[yypt-0].yyv.node); }
+9=>
+{yyval.node = yys[yypt-1].yyv.node; }
+10=>
+{yyval.node = ref Node(n_NOWAIT, yys[yypt-1].yyv.node, nil, nil, nil); }
+11=>
+yyval.node = yys[yyp+1].yyv.node;
+12=>
+{yyval.node = yys[yypt-1].yyv.node; }
+13=>
+yyval.node = yys[yyp+1].yyv.node;
+14=>
+{
+ yyval.node = mk(n_ADJ,
+ mk(n_ADJ,
+ ref Node(n_WORD,nil,nil,"or",nil),
+ mk(n_BLOCK, yys[yypt-2].yyv.node, nil)
+ ),
+ mk(n_BLOCK,yys[yypt-0].yyv.node,nil)
+ );
+ }
+15=>
+yyval.node = yys[yyp+1].yyv.node;
+16=>
+{
+ yyval.node = mk(n_ADJ,
+ mk(n_ADJ,
+ ref Node(n_WORD,nil,nil,"and",nil),
+ mk(n_BLOCK, yys[yypt-2].yyv.node, nil)
+ ),
+ mk(n_BLOCK,yys[yypt-0].yyv.node,nil)
+ );
+ }
+17=>
+{yyval.node = nil;}
+18=>
+yyval.node = yys[yyp+1].yyv.node;
+19=>
+{yyval.node = ref Node(n_PIPE, yys[yypt-3].yyv.node, yys[yypt-0].yyv.node, nil, yys[yypt-2].yyv.redir); }
+20=>
+yyval.node = yys[yyp+1].yyv.node;
+21=>
+{yyval.node = mk(n_ADJ, yys[yypt-1].yyv.node, yys[yypt-0].yyv.node); }
+22=>
+yyval.node = yys[yyp+1].yyv.node;
+23=>
+yyval.node = yys[yyp+1].yyv.node;
+24=>
+{yyval.node = mk(yys[yypt-1].yyv.optype, yys[yypt-2].yyv.node, yys[yypt-0].yyv.node); }
+25=>
+{yyval.node = mk(yys[yypt-1].yyv.optype, yys[yypt-2].yyv.node, yys[yypt-0].yyv.node); }
+26=>
+{yyval.node = mk(yys[yypt-0].yyv.optype, yys[yypt-1].yyv.node, nil); }
+27=>
+{yyval.node = ref Node(n_DUP, nil, nil, nil, yys[yypt-0].yyv.redir); }
+28=>
+{yyval.node = ref Node(n_REDIR, yys[yypt-0].yyv.node, nil, nil, yys[yypt-1].yyv.redir); }
+29=>
+yyval.node = yys[yyp+1].yyv.node;
+30=>
+{yyval.node = mk(n_ADJ, yys[yypt-1].yyv.node, yys[yypt-0].yyv.node); }
+31=>
+{yyval.node = mk(n_ADJ, yys[yypt-1].yyv.node, yys[yypt-0].yyv.node); }
+32=>
+{yyval.node = nil;}
+33=>
+yyval.node = yys[yyp+1].yyv.node;
+34=>
+{yyval.node = yys[yypt-0].yyv.node; }
+35=>
+{yyval.node = mk(n_ADJ, yys[yypt-2].yyv.node, yys[yypt-0].yyv.node); }
+36=>
+{yyval.node = mk(n_ADJ, yys[yypt-2].yyv.node, yys[yypt-0].yyv.node); }
+37=>
+yyval.node = yys[yyp+1].yyv.node;
+38=>
+{yyval.node = mk(n_CONCAT, yys[yypt-3].yyv.node, yys[yypt-0].yyv.node); }
+39=>
+{yyval.node = ref Node(n_WORD, nil, nil, yys[yypt-0].yyv.word, nil); }
+40=>
+{yyval.node = mk(yys[yypt-1].yyv.optype, yys[yypt-0].yyv.node, nil); }
+41=>
+{yyval.node = mk(n_LIST, yys[yypt-1].yyv.node, nil); }
+42=>
+{yyval.node = mk(n_BLOCK, yys[yypt-1].yyv.node, nil); }
+ }
+ }
+
+ return yyn;
+}
diff --git a/appl/cmd/sh/sh.y b/appl/cmd/sh/sh.y
new file mode 100644
index 00000000..083357c1
--- /dev/null
+++ b/appl/cmd/sh/sh.y
@@ -0,0 +1,2592 @@
+%{
+include "sys.m";
+ sys: Sys;
+ sprint: import sys;
+include "draw.m";
+include "bufio.m";
+ bufio: Bufio;
+include "string.m";
+ str: String;
+include "filepat.m";
+ filepat: Filepat;
+include "env.m";
+ env: Env;
+include "sh.m";
+ myself: Sh;
+ myselfbuiltin: Shellbuiltin;
+
+YYSTYPE: adt {
+ node: ref Node;
+ word: string;
+
+ redir: ref Redir;
+ optype: int;
+};
+
+YYLEX: adt {
+ lval: YYSTYPE;
+ err: string; # if error has occurred
+ errline: int; # line it occurred on.
+ path: string; # name of file that's being read.
+
+ # free caret state
+ wasdollar: int;
+ atendword: int;
+ eof: int;
+ cbuf: array of int; # last chars read
+ ncbuf: int; # number of chars in cbuf
+
+ f: ref Bufio->Iobuf;
+ s: string;
+ strpos: int; # string pos/cbuf index
+
+ linenum: int;
+ prompt: string;
+ lastnl: int;
+
+ initstring: fn(s: string): ref YYLEX;
+ initfile: fn(fd: ref Sys->FD, path: string): ref YYLEX;
+ lex: fn(l: self ref YYLEX): int;
+ error: fn(l: self ref YYLEX, err: string);
+ getc: fn(l: self ref YYLEX): int;
+ ungetc: fn(l: self ref YYLEX);
+
+ EOF: con -1;
+};
+
+Options: adt {
+ lflag,
+ nflag: int;
+ ctxtflags: int;
+ carg: string;
+};
+
+%}
+
+%module Sh {
+ # module definition is in shell.m
+}
+
+%token DUP REDIR WORD OP END ERROR ANDAND OROR
+
+%type <node> redir word nlsimple simple cmd shell assign
+%type <node> cmdsan cmdsa pipe comword line body list and2 or2
+%type <redir> DUP REDIR '|'
+%type <optype> OP '='
+%type <word> WORD
+
+%start shell
+%%
+shell: line end {yylex.lval.node = $line; return 0;}
+ | error end {yylex.lval.node = nil; return 0;}
+end: END
+ | '\n'
+line: or2
+ | cmdsa line {$$ = mkseq($cmdsa, $line); }
+body: or2
+ | cmdsan body {$$ = mkseq($cmdsan, $body); }
+cmdsa: or2 ';' {$$ = $or2; }
+ | or2 '&' {$$ = ref Node(n_NOWAIT, $or2, nil, nil, nil); }
+cmdsan: cmdsa
+ | or2 '\n' {$$ = $or2; }
+or2: and2
+ | or2 OROR and2 {
+ $$ = mk(n_ADJ,
+ mk(n_ADJ,
+ ref Node(n_WORD,nil,nil,"or",nil),
+ mk(n_BLOCK, $or2, nil)
+ ),
+ mk(n_BLOCK,$and2,nil)
+ );
+ }
+and2: pipe
+ | and2 ANDAND pipe {
+ $$ = mk(n_ADJ,
+ mk(n_ADJ,
+ ref Node(n_WORD,nil,nil,"and",nil),
+ mk(n_BLOCK, $and2, nil)
+ ),
+ mk(n_BLOCK,$pipe,nil)
+ );
+ }
+pipe: {$$ = nil;}
+ | cmd
+ | pipe '|' optnl cmd {$$ = ref Node(n_PIPE, $pipe, $cmd, nil, $2); }
+cmd: simple
+ | redir cmd {$$ = mk(n_ADJ, $redir, $cmd); }
+ | redir
+ | assign
+assign: word '=' assign {$$ = mk($2, $word, $assign); }
+ | word '=' simple {$$ = mk($2, $word, $simple); }
+ | word '=' {$$ = mk($2, $word, nil); }
+redir: DUP {$$ = ref Node(n_DUP, nil, nil, nil, $DUP); }
+ | REDIR word {$$ = ref Node(n_REDIR, $word, nil, nil, $REDIR); }
+simple: word
+ | simple word {$$ = mk(n_ADJ, $simple, $word); }
+ | simple redir {$$ = mk(n_ADJ, $simple, $redir); }
+list: optnl {$$ = nil;}
+ | nlsimple optnl
+nlsimple: optnl word {$$ = $word; }
+ | nlsimple optnl word {$$ = mk(n_ADJ, $nlsimple, $word); }
+ | nlsimple optnl redir {$$ = mk(n_ADJ, $nlsimple, $redir); }
+word: comword
+ | word '^' optnl comword {$$ = mk(n_CONCAT, $word, $comword); }
+comword: WORD {$$ = ref Node(n_WORD, nil, nil, $WORD, nil); }
+ | OP comword {$$ = mk($OP, $comword, nil); }
+ | '(' list ')' {$$ = mk(n_LIST, $list, nil); }
+ | '{' body '}' {$$ = mk(n_BLOCK, $body, nil); }
+optnl: # null
+ | optnl '\n'
+%%
+
+EPERM: con "permission denied";
+EPIPE: con "write on closed pipe";
+
+#SHELLRC: con "lib/profile";
+LIBSHELLRC: con "/lib/sh/profile";
+BUILTINPATH: con "/dis/sh";
+
+DEBUG: con 0;
+
+ENVSEP: con 0; # word seperator in external environment
+ENVHASHSIZE: con 7; # XXX profile usage of this...
+OAPPEND: con 16r80000; # make sure this doesn't clash with O* constants in sys.m
+OMASK: con 7;
+
+usage()
+{
+ sys->fprint(stderr(), "usage: sh [-ilexn] [-c command] [file [arg...]]\n");
+ raise "fail:usage";
+}
+
+badmodule(path: string)
+{
+ sys->fprint(sys->fildes(2), "sh: cannot load %s: %r\n", path);
+ raise "fail:bad module" ;
+}
+
+initialise()
+{
+ if (sys == nil) {
+ sys = load Sys Sys->PATH;
+
+ filepat = load Filepat Filepat->PATH;
+ if (filepat == nil) badmodule(Filepat->PATH);
+
+ str = load String String->PATH;
+ if (str == nil) badmodule(String->PATH);
+
+ bufio = load Bufio Bufio->PATH;
+ if (bufio == nil) badmodule(Bufio->PATH);
+
+ myself = load Sh "$self";
+ if (myself == nil) badmodule("$self(Sh)");
+
+ myselfbuiltin = load Shellbuiltin "$self";
+ if (myselfbuiltin == nil) badmodule("$self(Shellbuiltin)");
+
+ env = load Env Env->PATH;
+ }
+}
+blankopts: Options;
+init(drawcontext: ref Draw->Context, argv: list of string)
+{
+ initialise();
+ opts := blankopts;
+ if (argv != nil) {
+ if ((hd argv)[0] == '-')
+ opts.lflag++;
+ argv = tl argv;
+ }
+
+ interactive := 0;
+loop: while (argv != nil && hd argv != nil && (hd argv)[0] == '-') {
+ for (i := 1; i < len hd argv; i++) {
+ c := (hd argv)[i];
+ case c {
+ 'i' =>
+ interactive = Context.INTERACTIVE;
+ 'l' =>
+ opts.lflag++; # login (read $home/lib/profile)
+ 'n' =>
+ opts.nflag++; # don't fork namespace
+ 'e' =>
+ opts.ctxtflags |= Context.ERROREXIT;
+ 'x' =>
+ opts.ctxtflags |= Context.EXECPRINT;
+ 'c' =>
+ arg: string;
+ if (i < len hd argv - 1) {
+ arg = (hd argv)[i + 1:];
+ } else if (tl argv == nil || hd tl argv == "") {
+ usage();
+ } else {
+ arg = hd tl argv;
+ argv = tl argv;
+ }
+ argv = tl argv;
+ opts.carg = arg;
+ continue loop;
+ }
+ }
+ argv = tl argv;
+ }
+
+ sys->pctl(Sys->FORKFD, nil);
+ if (!opts.nflag)
+ sys->pctl(Sys->FORKNS, nil);
+ ctxt := Context.new(drawcontext);
+ ctxt.setoptions(opts.ctxtflags, 1);
+ if (opts.carg != nil) {
+ status := ctxt.run(stringlist2list("{" + opts.carg + "}" :: argv), !interactive);
+ if (!interactive) {
+ if (status != nil)
+ raise "fail:" + status;
+ exit;
+ }
+ setstatus(ctxt, status);
+ }
+
+ # if login shell, run standard init script
+ if (opts.lflag)
+ runscript(ctxt, LIBSHELLRC, nil, 0);
+
+ if (argv == nil) {
+# if (opts.lflag)
+# runscript(ctxt, SHELLRC, nil, 0);
+ if (isconsole(sys->fildes(0)))
+ interactive |= ctxt.INTERACTIVE;
+ ctxt.setoptions(interactive, 1);
+ runfile(ctxt, sys->fildes(0), "stdin", nil);
+ } else {
+ ctxt.setoptions(interactive, 1);
+ runscript(ctxt, hd argv, stringlist2list(tl argv), 1);
+ }
+}
+
+# XXX should this refuse to parse a non braced-block?
+parse(s: string): (ref Node, string)
+{
+ initialise();
+
+ lex := YYLEX.initstring(s);
+
+ return doparse(lex, "", 0);
+}
+
+system(drawctxt: ref Draw->Context, cmd: string): string
+{
+ initialise();
+ {
+ (n, err) := parse(cmd);
+ if (err != nil)
+ return err;
+ if (n == nil)
+ return nil;
+ return Context.new(drawctxt).run(ref Listnode(n, nil) :: nil, 0);
+ } exception e {
+ "fail:*" =>
+ return e[5:];
+ }
+}
+
+run(drawctxt: ref Draw->Context, argv: list of string): string
+{
+ initialise();
+ {
+ return Context.new(drawctxt).run(stringlist2list(argv), 0);
+ } exception e {
+ "fail:*" =>
+ return e[5:];
+ }
+}
+
+isconsole(fd: ref Sys->FD): int
+{
+ (ok1, d1) := sys->fstat(fd);
+ (ok2, d2) := sys->stat("/dev/cons");
+ if (ok1 < 0 || ok2 < 0)
+ return 0;
+ return d1.dtype == d2.dtype && d1.qid.path == d2.qid.path;
+}
+
+# run commands from file _path_
+runscript(ctxt: ref Context, path: string, args: list of ref Listnode, reporterr: int)
+{
+ {
+ fd := sys->open(path, Sys->OREAD);
+ if (fd != nil)
+ runfile(ctxt, fd, path, args);
+ else if (reporterr)
+ ctxt.fail("bad script path", sys->sprint("sh: cannot open %s: %r", path));
+ } exception e {
+ "fail:*" =>
+ if(!reporterr)
+ return;
+ raise;
+ }
+}
+
+# run commands from the opened file fd.
+# if interactive is non-zero, print a command prompt at appropriate times.
+runfile(ctxt: ref Context, fd: ref Sys->FD, path: string, args: list of ref Listnode)
+{
+ ctxt.push();
+ {
+ ctxt.setlocal("0", stringlist2list(path :: nil));
+ ctxt.setlocal("*", args);
+ lex := YYLEX.initfile(fd, path);
+ if (DEBUG) debug(sprint("parse(interactive == %d)", (ctxt.options() & ctxt.INTERACTIVE) != 0));
+ prompt := "" :: "" :: nil;
+ laststatus: string;
+ while (!lex.eof) {
+ interactive := ctxt.options() & ctxt.INTERACTIVE;
+ if (interactive) {
+ prompt = list2stringlist(ctxt.get("prompt"));
+ if (prompt == nil)
+ prompt = "; " :: "" :: nil;
+
+ sys->fprint(stderr(), "%s", hd prompt);
+ if (tl prompt == nil) {
+ prompt = hd prompt :: "" :: nil;
+ }
+ }
+ (n, err) := doparse(lex, hd tl prompt, !interactive);
+ if (err != nil) {
+ sys->fprint(stderr(), "sh: %s\n", err);
+ if (!interactive)
+ raise "fail:parse error";
+ } else if (n != nil) {
+ if (interactive) {
+ {
+ laststatus = walk(ctxt, n, 0);
+ } exception e2 {
+ "fail:*" =>
+ laststatus = e2[5:];
+ }
+ } else
+ laststatus = walk(ctxt, n, 0);
+ setstatus(ctxt, laststatus);
+ if ((ctxt.options() & ctxt.ERROREXIT) && laststatus != nil)
+ break;
+ }
+ }
+ if (laststatus != nil)
+ raise "fail:" + laststatus;
+ ctxt.pop();
+ }
+ exception e {
+ "fail:*" =>
+ ctxt.pop();
+ raise;
+ }
+}
+
+nonexistent(e: string): int
+{
+ errs := array[] of {"does not exist", "directory entry not found"};
+ for (i := 0; i < len errs; i++){
+ j := len errs[i];
+ if (j <= len e && e[len e-j:] == errs[i])
+ return 1;
+ }
+ return 0;
+}
+
+Redirword: adt {
+ fd: ref Sys->FD;
+ w: string;
+ r: Redir;
+};
+
+Redirlist: adt {
+ r: list of Redirword;
+};
+
+# a hack so that the structure of walk() doesn't change much
+# to accomodate echo|wc&
+# transform the above into {echo|wc}$*&
+# which should amount to exactly the same thing.
+pipe2cmd(n: ref Node): ref Node
+{
+ if (n == nil || n.ntype != n_PIPE)
+ return n;
+ return mk(n_ADJ, mk(n_BLOCK,n,nil), mk(n_VAR,ref Node(n_WORD,nil,nil,"*",nil),nil));
+}
+
+# walk a node tree.
+# last is non-zero if this walk is the last action
+# this shell process will take before exiting (i.e. redirections
+# don't require a new process to avoid side effects)
+walk(ctxt: ref Context, n: ref Node, last: int): string
+{
+ if (DEBUG) debug(sprint("walking: %s", cmd2string(n)));
+ # avoid tail recursion stack explosion
+ while (n != nil && n.ntype == n_SEQ) {
+ status := walk(ctxt, n.left, 0);
+ if (ctxt.options() & ctxt.ERROREXIT && status != nil)
+ raise "fail:" + status;
+ setstatus(ctxt, status);
+ n = n.right;
+ }
+ if (n == nil)
+ return nil;
+ case (n.ntype) {
+ n_PIPE =>
+ return waitfor(ctxt, walkpipeline(ctxt, n, nil, -1));
+ n_ASSIGN or n_LOCAL =>
+ assign(ctxt, n);
+ return nil;
+ * =>
+ bg := 0;
+ if (n.ntype == n_NOWAIT) {
+ bg = 1;
+ n = pipe2cmd(n.left);
+ }
+
+ redirs := ref Redirlist(nil);
+ line := glob(glom(ctxt, n, redirs, nil));
+
+ if (bg) {
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 1, line, redirs, startchan);
+ (pid, nil) := <-startchan;
+ redirs = nil;
+ if (DEBUG) debug("started background process "+ string pid);
+ ctxt.set("apid", ref Listnode(nil, string pid) :: nil);
+ return nil;
+ } else {
+ return runsync(ctxt, line, redirs, last);
+ }
+ }
+}
+
+assign(ctxt: ref Context, n: ref Node): list of ref Listnode
+{
+ redirs := ref Redirlist;
+ val: list of ref Listnode;
+ if (n.right != nil && (n.right.ntype == n_ASSIGN || n.right.ntype == n_LOCAL))
+ val = assign(ctxt, n.right);
+ else
+ val = glob(glom(ctxt, n.right, redirs, nil));
+ vars := glom(ctxt, n.left, redirs, nil);
+ if (vars == nil)
+ ctxt.fail("bad assign", "sh: nil variable name");
+ if (redirs.r != nil)
+ ctxt.fail("bad assign", "sh: redirections not allowed in assignment");
+ tval := val;
+ for (; vars != nil; vars = tl vars) {
+ vname := deglob((hd vars).word);
+ if (vname == nil)
+ ctxt.fail("bad assign", "sh: bad variable name");
+ v: list of ref Listnode = nil;
+ if (tl vars == nil)
+ v = tval;
+ else if (tval != nil)
+ v = hd tval :: nil;
+ if (n.ntype == n_ASSIGN)
+ ctxt.set(vname, v);
+ else
+ ctxt.setlocal(vname, v);
+ if (tval != nil)
+ tval = tl tval;
+ }
+ return val;
+}
+
+walkpipeline(ctxt: ref Context, n: ref Node, wrpipe: ref Sys->FD, wfdno: int): list of int
+{
+ if (n == nil)
+ return nil;
+
+ fds := array[2] of ref Sys->FD;
+ pids: list of int;
+ rfdno := -1;
+ if (n.ntype == n_PIPE) {
+ if (sys->pipe(fds) == -1)
+ ctxt.fail("no pipe", sys->sprint("sh: cannot make pipe: %r"));
+ nwfdno := -1;
+ if (n.redir != nil) {
+ (fd1, fd2) := (n.redir.fd2, n.redir.fd1);
+ if (fd2 == -1)
+ (fd1, fd2) = (fd2, fd1);
+ (nwfdno, rfdno) = (fd2, fd1);
+ }
+ pids = walkpipeline(ctxt, n.left, fds[1], nwfdno);
+ fds[1] = nil;
+ n = n.right;
+ }
+ r := ref Redirlist(nil);
+ rlist := glob(glom(ctxt, n, r, nil));
+ if (fds[0] != nil) {
+ if (rfdno == -1)
+ rfdno = 0;
+ r.r = Redirword(fds[0], nil, Redir(Sys->OREAD, rfdno, -1)) :: r.r;
+ }
+ if (wrpipe != nil) {
+ if (wfdno == -1)
+ wfdno = 1;
+ r.r = Redirword(wrpipe, nil, Redir(Sys->OWRITE, wfdno, -1)) :: r.r;
+ }
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 1, rlist, r, startchan);
+ (pid, nil) := <-startchan;
+ if (DEBUG) debug("started pipe process "+string pid);
+ return pid :: pids;
+}
+
+makeredir(f: string, mode: int, fd: int): Redirword
+{
+ return Redirword(nil, f, Redir(mode, fd, -1));
+}
+
+# expand substitution operators in a node list
+glom(ctxt: ref Context, n: ref Node, redirs: ref Redirlist, onto: list of ref Listnode)
+ : list of ref Listnode
+{
+ if (n == nil) return nil;
+
+ if (n.ntype != n_ADJ)
+ return listjoin(glomoperation(ctxt, n, redirs), onto);
+
+ nlist := glom(ctxt, n.right, redirs, onto);
+
+ if (n.left.ntype != n_ADJ) {
+ # if it's a terminal node
+ nlist = listjoin(glomoperation(ctxt, n.left, redirs), nlist);
+ } else
+ nlist = glom(ctxt, n.left, redirs, nlist);
+ return nlist;
+}
+
+listjoin(left, right: list of ref Listnode): list of ref Listnode
+{
+ l: list of ref Listnode;
+ for (; left != nil; left = tl left)
+ l = hd left :: l;
+ for (; l != nil; l = tl l)
+ right = hd l :: right;
+ return right;
+}
+
+glomoperation(ctxt: ref Context, n: ref Node, redirs: ref Redirlist): list of ref Listnode
+{
+ if (n == nil)
+ return nil;
+
+ nlist: list of ref Listnode;
+ case n.ntype {
+ n_WORD =>
+ nlist = ref Listnode(nil, n.word) :: nil;
+ n_REDIR =>
+ wlist := glob(glom(ctxt, n.left, ref Redirlist(nil), nil));
+ if (len wlist != 1 || (hd wlist).word == nil)
+ ctxt.fail("bad redir", "sh: single redirection operand required");
+
+ # add to redir list
+ redirs.r = Redirword(nil, (hd wlist).word, *n.redir) :: redirs.r;
+ n_DUP =>
+ redirs.r = Redirword(nil, "", *n.redir) :: redirs.r;
+ n_LIST =>
+ nlist = glom(ctxt, n.left, redirs, nil);
+ n_CONCAT =>
+ nlist = concat(ctxt, glom(ctxt, n.left, redirs, nil), glom(ctxt, n.right, redirs, nil));
+ n_VAR or n_SQUASH or n_COUNT =>
+ arg := glom(ctxt, n.left, ref Redirlist(nil), nil);
+ if (len arg == 1 && (hd arg).cmd != nil)
+ nlist = subsbuiltin(ctxt, (hd arg).cmd.left);
+ else if (len arg != 1 || (hd arg).word == nil)
+ ctxt.fail("bad $ arg", "sh: bad variable name");
+ else
+ nlist = ctxt.get(deglob((hd arg).word));
+ case n.ntype {
+ n_VAR =>;
+ n_COUNT =>
+ nlist = ref Listnode(nil, string len nlist) :: nil;
+ n_SQUASH =>
+ # XXX could squash with first char of $ifs, perhaps
+ nlist = ref Listnode(nil, squash(list2stringlist(nlist), " ")) :: nil;
+ }
+ n_BQ or n_BQ2 =>
+ arg := glom(ctxt, n.left, ref Redirlist(nil), nil);
+ seps := "";
+ if (n.ntype == n_BQ) {
+ seps = squash(list2stringlist(ctxt.get("ifs")), "");
+ if (seps == nil)
+ seps = " \t\n\r";
+ }
+ (nlist, nil) = bq(ctxt, glob(arg), seps);
+ n_BLOCK =>
+ nlist = ref Listnode(n, "") :: nil;
+ n_ASSIGN or n_LOCAL =>
+ ctxt.fail("bad assign", "sh: assignment in invalid context");
+ * =>
+ panic("bad node type "+string n.ntype+" in glomop");
+ }
+ return nlist;
+}
+
+subsbuiltin(ctxt: ref Context, n: ref Node): list of ref Listnode
+{
+ if (n == nil || n.ntype == n_SEQ ||
+ n.ntype == n_PIPE || n.ntype == n_NOWAIT)
+ ctxt.fail("bad $ arg", "sh: invalid argument to ${} operator");
+ r := ref Redirlist;
+ cmd := glob(glom(ctxt, n, r, nil));
+ if (r.r != nil)
+ ctxt.fail("bad $ arg", "sh: redirection not allowed in substitution");
+ r = nil;
+ if (cmd == nil || (hd cmd).word == nil || (hd cmd).cmd != nil)
+ ctxt.fail("bad $ arg", "sh: bad builtin name");
+
+ (nil, bmods) := findbuiltin(ctxt.env.sbuiltins, (hd cmd).word);
+ if (bmods == nil)
+ ctxt.fail("builtin not found",
+ sys->sprint("sh: builtin %s not found", (hd cmd).word));
+ return (hd bmods)->runsbuiltin(ctxt, myself, cmd);
+}
+
+#
+# backquote substitution (could be done in a builtin)
+#
+
+getbq(nil: ref Context, fd: ref Sys->FD, seps: string): list of ref Listnode
+{
+ buf := array[Sys->ATOMICIO] of byte;
+ buflen := 0;
+ while ((n := sys->read(fd, buf[buflen:], len buf - buflen)) > 0) {
+ buflen += n;
+ if (buflen == len buf) {
+ nbuf := array[buflen * 2] of byte;
+ nbuf[0:] = buf[0:];
+ buf = nbuf;
+ }
+ }
+ l: list of string;
+ if (seps != nil)
+ (nil, l) = sys->tokenize(string buf[0:buflen], seps);
+ else
+ l = string buf[0:buflen] :: nil;
+ buf = nil;
+ return stringlist2list(l);
+}
+
+bq(ctxt: ref Context, cmd: list of ref Listnode, seps: string): (list of ref Listnode, string)
+{
+ fds := array[2] of ref Sys->FD;
+ if (sys->pipe(fds) == -1)
+ ctxt.fail("no pipe", sys->sprint("sh: cannot make pipe: %r"));
+
+ r := rdir(fds[1]);
+ fds[1] = nil;
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 0, cmd, r, startchan);
+ (exepid, exprop) := <-startchan;
+ r = nil;
+ bqlist := getbq(ctxt, fds[0], seps);
+ waitfor(ctxt, exepid :: nil);
+ if (exprop.name != nil)
+ raise exprop.name;
+ return (bqlist, nil);
+}
+
+# get around compiler temporaries bug
+rdir(fd: ref Sys->FD): ref Redirlist
+{
+ return ref Redirlist(Redirword(fd, nil, Redir(Sys->OWRITE, 1, -1)) :: nil);
+}
+
+#
+# concatenation
+#
+
+concatwords(p1, p2: ref Listnode): ref Listnode
+{
+ if (p1.word == nil && p1.cmd != nil)
+ p1.word = cmd2string(p1.cmd);
+ if (p2.word == nil && p2.cmd != nil)
+ p2.word = cmd2string(p2.cmd);
+ return ref Listnode(nil, p1.word + p2.word);
+}
+
+concat(ctxt: ref Context, nl1, nl2: list of ref Listnode): list of ref Listnode
+{
+ if (nl1 == nil || nl2 == nil) {
+ if (nl1 == nil && nl2 == nil)
+ return nil;
+ ctxt.fail("bad concatenation", "sh: null list in concatenation");
+ }
+
+ ret: list of ref Listnode;
+ if (tl nl1 == nil || tl nl2 == nil) {
+ for (p1 := nl1; p1 != nil; p1 = tl p1)
+ for (p2 := nl2; p2 != nil; p2 = tl p2)
+ ret = concatwords(hd p1, hd p2) :: ret;
+ } else {
+ if (len nl1 != len nl2)
+ ctxt.fail("bad concatenation", "sh: lists of differing sizes can't be concatenated");
+ while (nl1 != nil) {
+ ret = concatwords(hd nl1, hd nl2) :: ret;
+ (nl1, nl2) = (tl nl1, tl nl2);
+ }
+ }
+ return revlist(ret);
+}
+
+Expropagate: adt {
+ name: string;
+};
+
+# run an asynchronous process, first redirecting its I/O
+# as specified in _redirs_.
+# it sends its process ID down _startchan_ before executing.
+# it has to jump through one or two hoops to make sure
+# Sys->FD ref counting is done correctly. this code
+# is more sensitive than you might think.
+runasync(ctxt: ref Context, copyenv: int, argv: list of ref Listnode, redirs: ref Redirlist,
+ startchan: chan of (int, ref Expropagate))
+{
+ status: string;
+
+ pid := sys->pctl(sys->FORKFD, nil);
+ if (DEBUG) debug(sprint("in async (len redirs: %d)", len redirs.r));
+ ctxt = ctxt.copy(copyenv);
+ exprop := ref Expropagate;
+ {
+ newfdl := doredirs(ctxt, redirs);
+ redirs = nil;
+ if (newfdl != nil)
+ sys->pctl(Sys->NEWFD, newfdl);
+ # stop the old waitfd from holding the intermediate
+ # file descriptor group open.
+ ctxt.waitfd = waitfd();
+ # N.B. it's important that the sync is done here, not
+ # before doredirs, as otherwise there's some sort of
+ # race condition that leads to pipe non-completion.
+ startchan <-= (pid, exprop);
+ startchan = nil;
+ status = ctxt.run(argv, copyenv);
+ } exception e {
+ "fail:*" =>
+ exprop.name = e;
+ if (startchan != nil)
+ startchan <-= (pid, exprop);
+ raise e;
+ }
+ if (status != nil) {
+ # don't propagate bad status as an exception.
+ raise "fail:" + status;
+ }
+}
+
+# run a synchronous process
+runsync(ctxt: ref Context, argv: list of ref Listnode,
+ redirs: ref Redirlist, last: int): string
+{
+ if (DEBUG) debug(sys->sprint("in sync (len redirs: %d; last: %d)", len redirs.r, last));
+ if (redirs.r != nil && !last) {
+ # a new process is required to shield redirection side effects
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 0, argv, redirs, startchan);
+ (pid, exprop) := <-startchan;
+ redirs = nil;
+ r := waitfor(ctxt, pid :: nil);
+ if (exprop.name != nil)
+ raise exprop.name;
+ return r;
+ } else {
+ newfdl := doredirs(ctxt, redirs);
+ redirs = nil;
+ if (newfdl != nil)
+ sys->pctl(Sys->NEWFD, newfdl);
+ return ctxt.run(argv, last);
+ }
+}
+
+# path is prefixed with: "/", "#", "./" or "../"
+absolute(p: string): int
+{
+ if (len p < 2)
+ return 0;
+ if (p[0] == '/' || p[0] == '#')
+ return 1;
+ if (len p < 3 || p[0] != '.')
+ return 0;
+ if (p[1] == '/')
+ return 1;
+ if (p[1] == '.' && p[2] == '/')
+ return 1;
+ return 0;
+}
+
+runexternal(ctxt: ref Context, args: list of ref Listnode, last: int): string
+{
+ progname := (hd args).word;
+ disfile := 0;
+ if (len progname >= 4 && progname[len progname-4:] == ".dis")
+ disfile = 1;
+ pathlist: list of string;
+ if (absolute(progname))
+ pathlist = list of {""};
+ else if ((pl := ctxt.get("path")) != nil)
+ pathlist = list2stringlist(pl);
+ else
+ pathlist = list of {"/dis", "."};
+
+ err := "";
+ do {
+ path: string;
+ if (hd pathlist != "")
+ path = hd pathlist + "/" + progname;
+ else
+ path = progname;
+
+ npath := path;
+ if (!disfile)
+ npath += ".dis";
+ mod := load Command npath;
+ if (mod != nil) {
+ argv := list2stringlist(args);
+ export(ctxt.env.localenv);
+
+ if (last) {
+ {
+ sys->pctl(Sys->NEWFD, ctxt.keepfds);
+ mod->init(ctxt.drawcontext, argv);
+ exit;
+ } exception e {
+ EPIPE =>
+ return EPIPE;
+ "fail:*" =>
+ return e[5:];
+ }
+ }
+ extstart := chan of int;
+ spawn externalexec(mod, ctxt.drawcontext, argv, extstart, ctxt.keepfds);
+ pid := <-extstart;
+ if (DEBUG) debug("started external externalexec; pid is "+string pid);
+ return waitfor(ctxt, pid :: nil);
+ }
+ err = sys->sprint("%r");
+ if (nonexistent(err)) {
+ # try and run it as a shell script
+ if (!disfile && (fd := sys->open(path, Sys->OREAD)) != nil) {
+ (ok, info) := sys->fstat(fd);
+ # make permission checking more accurate later
+ if (ok == 0 && (info.mode & Sys->DMDIR) == 0
+ && (info.mode & 8r111) != 0)
+ return runhashpling(ctxt, fd, path, tl args, last);
+ };
+ err = sys->sprint("%r");
+ }
+ pathlist = tl pathlist;
+ } while (pathlist != nil && nonexistent(err));
+ diagnostic(ctxt, sys->sprint("%s: %s", progname, err));
+ return err;
+}
+
+runhashpling(ctxt: ref Context, fd: ref Sys->FD,
+ path: string, argv: list of ref Listnode, last: int): string
+{
+ header := array[1024] of byte;
+ n := sys->read(fd, header, len header);
+ for (i := 0; i < n; i++)
+ if (header[i] == byte '\n')
+ break;
+ if (i == n || i < 3 || header[0] != byte('#') || header[1] != byte('!')) {
+ diagnostic(ctxt, "bad script header on " + path);
+ return "bad header";
+ }
+ (nil, args) := sys->tokenize(string header[2:i], " \t");
+ if (args == nil) {
+ diagnostic(ctxt, "empty header on " + path);
+ return "bad header";
+ }
+ header = nil;
+ fd = nil;
+ nargs: list of ref Listnode;
+ for (; args != nil; args = tl args)
+ nargs = ref Listnode(nil, hd args) :: nargs;
+ nargs = ref Listnode(nil, path) :: nargs;
+ for (; argv != nil; argv = tl argv)
+ nargs = hd argv :: nargs;
+ return runexternal(ctxt, revlist(nargs), last);
+}
+
+runblock(ctxt: ref Context, args: list of ref Listnode, last: int): string
+{
+ # block execute (we know that hd args represents a block)
+ cmd := (hd args).cmd;
+ if (cmd == nil) {
+ # parse block from first argument
+ lex := YYLEX.initstring((hd args).word);
+
+ err: string;
+ (cmd, err) = doparse(lex, "", 0);
+ if (cmd == nil)
+ ctxt.fail("parse error", "sh: "+err);
+
+ (hd args).cmd = cmd;
+ }
+ # now we've got a parsed block
+ ctxt.push();
+ {
+ ctxt.setlocal("0", hd args :: nil);
+ ctxt.setlocal("*", tl args);
+ if (cmd != nil && cmd.ntype == n_BLOCK)
+ cmd = cmd.left;
+ status := walk(ctxt, cmd, last);
+ ctxt.pop();
+ return status;
+ } exception e{
+ "fail:*" =>
+ ctxt.pop();
+ raise;
+ }
+}
+
+# return (ok, val) where ok is non-zero is builtin was found,
+# val is return status of builtin
+trybuiltin(ctxt: ref Context, args: list of ref Listnode, lseq: int)
+ : (int, string)
+{
+ (n, bmods) := findbuiltin(ctxt.env.builtins, (hd args).word);
+ if (bmods == nil)
+ return (0, nil);
+ return (1, (hd bmods)->runbuiltin(ctxt, myself, args, lseq));
+}
+
+keepfdstr(ctxt: ref Context): string
+{
+ s := "";
+ for (f := ctxt.keepfds; f != nil; f = tl f) {
+ s += string hd f;
+ if (tl f != nil)
+ s += ",";
+ }
+ return s;
+}
+
+externalexec(mod: Command,
+ drawcontext: ref Draw->Context, argv: list of string, startchan: chan of int, keepfds: list of int)
+{
+ if (DEBUG) debug(sprint("externalexec(%s,... [%d args])", hd argv, len argv));
+ sys->pctl(Sys->NEWFD, keepfds);
+ startchan <-= sys->pctl(0, nil);
+ {
+ mod->init(drawcontext, argv);
+ }
+ exception e{
+ EPIPE =>
+ raise "fail:" + EPIPE;
+ }
+}
+
+dup(ctxt: ref Context, fd1, fd2: int): int
+{
+ # shuffle waitfd out of the way if it's being attacked
+ if (ctxt.waitfd.fd == fd2) {
+ ctxt.waitfd = waitfd();
+ if (ctxt.waitfd.fd == fd2)
+ panic(sys->sprint("reopen of waitfd gave same fd (%d)", ctxt.waitfd.fd));
+ }
+ return sys->dup(fd1, fd2);
+}
+
+# with thanks to tiny/sh.b
+# return error status if redirs failed
+doredirs(ctxt: ref Context, redirs: ref Redirlist): list of int
+{
+ if (redirs.r == nil)
+ return nil;
+ keepfds := ctxt.keepfds;
+ rl := redirs.r;
+ redirs = nil;
+ for (; rl != nil; rl = tl rl) {
+ (rfd, path, (mode, fd1, fd2)) := hd rl;
+ if (path == nil && rfd == nil) {
+ # dup
+ if (fd1 == -1 || fd2 == -1)
+ ctxt.fail("bad redir", "sh: invalid dup");
+
+ if (dup(ctxt, fd2, fd1) == -1)
+ ctxt.fail("bad redir", sys->sprint("sh: cannot dup: %r"));
+ keepfds = fd1 :: keepfds;
+ continue;
+ }
+ # redir
+ if (fd1 == -1) {
+ if ((mode & OMASK) == Sys->OWRITE)
+ fd1 = 1;
+ else
+ fd1 = 0;
+ }
+ if (rfd == nil) {
+ (append, omode) := (mode & OAPPEND, mode & ~OAPPEND);
+ err := "";
+ case mode {
+ Sys->OREAD =>
+ rfd = sys->open(path, omode);
+ Sys->OWRITE | OAPPEND or
+ Sys->ORDWR =>
+ rfd = sys->open(path, omode);
+ err = sprint("%r");
+ if (rfd == nil && nonexistent(err)) {
+ rfd = sys->create(path, omode, 8r666);
+ err = nil;
+ }
+ Sys->OWRITE =>
+ rfd = sys->create(path, omode, 8r666);
+ err = sprint("%r");
+ if (rfd == nil && err == EPERM) {
+ # try open; can't create on a file2chan (pipe)
+ rfd = sys->open(path, omode);
+ nerr := sprint("%r");
+ if(!nonexistent(nerr))
+ err = nerr;
+ }
+ }
+ if (rfd == nil) {
+ if (err == nil)
+ err = sprint("%r");
+ ctxt.fail("bad redir", sys->sprint("sh: cannot open %s: %s", path, err));
+ }
+ if (append)
+ sys->seek(rfd, big 0, Sys->SEEKEND); # not good enough, but alright for some purposes.
+ }
+ # XXX what happens if rfd.fd == fd1?
+ # it probably gets closed automatically... which is not what we want!
+ dup(ctxt, rfd.fd, fd1);
+ keepfds = fd1 :: keepfds;
+ }
+ ctxt.keepfds = keepfds;
+ return ctxt.waitfd.fd :: keepfds;
+}
+
+#
+# waiter utility routines
+#
+
+waitfd(): ref Sys->FD
+{
+ wf := string sys->pctl(0, nil) + "/wait";
+ waitfd := sys->open("#p/"+wf, Sys->OREAD);
+ if (waitfd == nil)
+ waitfd = sys->open("/prog/"+wf, Sys->OREAD);
+ if (waitfd == nil)
+ panic(sys->sprint("cannot open wait file: %r"));
+ return waitfd;
+}
+
+waitfor(ctxt: ref Context, pids: list of int): string
+{
+ if (pids == nil)
+ return nil;
+ status := array[len pids] of string;
+ wcount := len status;
+ buf := array[Sys->WAITLEN] of byte;
+ onebad := 0;
+ for(;;){
+ n := sys->read(ctxt.waitfd, buf, len buf);
+ if(n < 0)
+ panic(sys->sprint("error on wait read: %r"));
+ (who, line, s) := parsewaitstatus(ctxt, string buf[0:n]);
+ if (s != nil) {
+ if (len s >= 5 && s[0:5] == "fail:")
+ s = s[5:];
+ else
+ diagnostic(ctxt, line);
+ }
+ for ((i, pl) := (0, pids); pl != nil; (i, pl) = (i+1, tl pl))
+ if (who == hd pl)
+ break;
+ if (i < len status) {
+ # wait returns two records for a killed process...
+ if (status[i] == nil || s != "killed") {
+ onebad += s != nil;
+ status[i] = s;
+ if (wcount-- <= 1)
+ break;
+ }
+ }
+ }
+ if (!onebad)
+ return nil;
+ r := status[len status - 1];
+ for (i := len status - 2; i >= 0; i--)
+ r += "|" + status[i];
+ return r;
+}
+
+parsewaitstatus(ctxt: ref Context, status: string): (int, string, string)
+{
+ for (i := 0; i < len status; i++)
+ if (status[i] == ' ')
+ break;
+ if (i == len status - 1 || status[i+1] != '"')
+ ctxt.fail("bad wait read",
+ sys->sprint("sh: bad exit status '%s'", status));
+
+ for (i+=2; i < len status; i++)
+ if (status[i] == '"')
+ break;
+ if (i > len status - 2 || status[i+1] != ':')
+ ctxt.fail("bad wait read",
+ sys->sprint("sh: bad exit status '%s'", status));
+
+ return (int status, status, status[i+2:]);
+}
+
+panic(s: string)
+{
+ sys->fprint(stderr(), "sh panic: %s\n", s);
+ raise "panic";
+}
+
+diagnostic(ctxt: ref Context, s: string)
+{
+ if (ctxt.options() & Context.VERBOSE)
+ sys->fprint(stderr(), "sh: %s\n", s);
+}
+
+#
+# Sh environment stuff
+#
+
+Context.new(drawcontext: ref Draw->Context): ref Context
+{
+ initialise();
+ if (env != nil)
+ env->clone();
+ ctxt := ref Context(
+ ref Environment(
+ ref Builtins(nil, 0),
+ ref Builtins(nil, 0),
+ nil,
+ newlocalenv(nil)
+ ),
+ waitfd(),
+ drawcontext,
+ 0 :: 1 :: 2 :: nil
+ );
+ myselfbuiltin->initbuiltin(ctxt, myself);
+ ctxt.env.localenv.flags = ctxt.VERBOSE;
+ for (vl := ctxt.get("autoload"); vl != nil; vl = tl vl)
+ if ((hd vl).cmd == nil && (hd vl).word != nil)
+ loadmodule(ctxt, (hd vl).word);
+ return ctxt;
+}
+
+Context.copy(ctxt: self ref Context, copyenv: int): ref Context
+{
+ # XXX could check to see that we are definitely in a
+ # new process, because there'll be problems if not (two processes
+ # simultaneously reading the same wait file)
+ nctxt := ref Context(ctxt.env, waitfd(), ctxt.drawcontext, ctxt.keepfds);
+
+ if (copyenv) {
+ if (env != nil)
+ env->clone();
+ nctxt.env = ref Environment(
+ copybuiltins(ctxt.env.sbuiltins),
+ copybuiltins(ctxt.env.builtins),
+ ctxt.env.bmods,
+ copylocalenv(ctxt.env.localenv)
+ );
+ }
+ return nctxt;
+}
+
+Context.set(ctxt: self ref Context, name: string, val: list of ref Listnode)
+{
+ e := ctxt.env.localenv;
+ idx := hashfn(name, len e.vars);
+ for (;;) {
+ v := hashfind(e.vars, idx, name);
+ if (v == nil) {
+ if (e.pushed == nil) {
+ flags := Var.CHANGED;
+ if (noexport(name))
+ flags |= Var.NOEXPORT;
+ hashadd(e.vars, idx, ref Var(name, val, flags));
+ return;
+ }
+ } else {
+ v.val = val;
+ v.flags |= Var.CHANGED;
+ return;
+ }
+ e = e.pushed;
+ }
+}
+
+Context.get(ctxt: self ref Context, name: string): list of ref Listnode
+{
+ if (name == nil)
+ return nil;
+
+ idx := -1;
+ # cope with $1, $2, etc
+ if (name[0] > '0' && name[0] <= '9') {
+ i: int;
+ for (i = 0; i < len name; i++)
+ if (name[i] < '0' || name[i] > '9')
+ break;
+ if (i >= len name) {
+ idx = int name - 1;
+ name = "*";
+ }
+ }
+
+ v := varfind(ctxt.env.localenv, name);
+ if (v != nil) {
+ if (idx != -1)
+ return index(v.val, idx);
+ return v.val;
+ }
+ return nil;
+}
+
+# return the whole environment.
+Context.envlist(ctxt: self ref Context): list of (string, list of ref Listnode)
+{
+ t := array[ENVHASHSIZE] of list of ref Var;
+ for (e := ctxt.env.localenv; e != nil; e = e.pushed) {
+ for (i := 0; i < len e.vars; i++) {
+ for (vl := e.vars[i]; vl != nil; vl = tl vl) {
+ v := hd vl;
+ idx := hashfn(v.name, len e.vars);
+ if (hashfind(t, idx, v.name) == nil)
+ hashadd(t, idx, v);
+ }
+ }
+ }
+
+ l: list of (string, list of ref Listnode);
+ for (i := 0; i < ENVHASHSIZE; i++) {
+ for (vl := t[i]; vl != nil; vl = tl vl) {
+ v := hd vl;
+ l = (v.name, v.val) :: l;
+ }
+ }
+ return l;
+}
+
+Context.setlocal(ctxt: self ref Context, name: string, val: list of ref Listnode)
+{
+ e := ctxt.env.localenv;
+ idx := hashfn(name, len e.vars);
+ v := hashfind(e.vars, idx, name);
+ if (v == nil) {
+ flags := Var.CHANGED;
+ if (noexport(name))
+ flags |= Var.NOEXPORT;
+ hashadd(e.vars, idx, ref Var(name, val, flags));
+ } else {
+ v.val = val;
+ v.flags |= Var.CHANGED;
+ }
+}
+
+
+Context.push(ctxt: self ref Context)
+{
+ ctxt.env.localenv = newlocalenv(ctxt.env.localenv);
+}
+
+Context.pop(ctxt: self ref Context)
+{
+ if (ctxt.env.localenv.pushed == nil)
+ panic("unbalanced contexts in shell environment");
+ else {
+ oldv := ctxt.env.localenv.vars;
+ ctxt.env.localenv = ctxt.env.localenv.pushed;
+ for (i := 0; i < len oldv; i++) {
+ for (vl := oldv[i]; vl != nil; vl = tl vl) {
+ if ((v := varfind(ctxt.env.localenv, (hd vl).name)) != nil)
+ v.flags |= Var.CHANGED;
+ else
+ ctxt.set((hd vl).name, nil);
+ }
+ }
+ }
+}
+
+Context.run(ctxt: self ref Context, args: list of ref Listnode, last: int): string
+{
+ if (args == nil || ((hd args).cmd == nil && (hd args).word == nil))
+ return nil;
+ cmd := hd args;
+ if (cmd.cmd != nil || cmd.word[0] == '{') # }
+ return runblock(ctxt, args, last);
+
+ if (ctxt.options() & ctxt.EXECPRINT)
+ sys->fprint(stderr(), "%s\n", quoted(args, 0));
+ (doneit, status) := trybuiltin(ctxt, args, last);
+ if (!doneit)
+ status = runexternal(ctxt, args, last);
+
+ return status;
+}
+
+Context.addmodule(ctxt: self ref Context, name: string, mod: Shellbuiltin)
+{
+ mod->initbuiltin(ctxt, myself);
+ ctxt.env.bmods = (name, mod->getself()) :: ctxt.env.bmods;
+}
+
+Context.addbuiltin(c: self ref Context, name: string, mod: Shellbuiltin)
+{
+ addbuiltin(c.env.builtins, name, mod);
+}
+
+Context.removebuiltin(c: self ref Context, name: string, mod: Shellbuiltin)
+{
+ removebuiltin(c.env.builtins, name, mod);
+}
+
+Context.addsbuiltin(c: self ref Context, name: string, mod: Shellbuiltin)
+{
+ addbuiltin(c.env.sbuiltins, name, mod);
+}
+
+Context.removesbuiltin(c: self ref Context, name: string, mod: Shellbuiltin)
+{
+ removebuiltin(c.env.sbuiltins, name, mod);
+}
+
+varfind(e: ref Localenv, name: string): ref Var
+{
+ idx := hashfn(name, len e.vars);
+ for (; e != nil; e = e.pushed)
+ for (vl := e.vars[idx]; vl != nil; vl = tl vl)
+ if ((hd vl).name == name)
+ return hd vl;
+ return nil;
+}
+
+Context.fail(ctxt: self ref Context, ename: string, err: string)
+{
+ if (ctxt.options() & Context.VERBOSE)
+ sys->fprint(stderr(), "%s\n", err);
+ raise "fail:" + ename;
+}
+
+Context.setoptions(ctxt: self ref Context, flags, on: int): int
+{
+ old := ctxt.env.localenv.flags;
+ if (on)
+ ctxt.env.localenv.flags |= flags;
+ else
+ ctxt.env.localenv.flags &= ~flags;
+ return old;
+}
+
+Context.options(ctxt: self ref Context): int
+{
+ return ctxt.env.localenv.flags;
+}
+
+hashfn(s: string, n: int): int
+{
+ h := 0;
+ m := len s;
+ for(i:=0; i<m; i++){
+ h = 65599*h+s[i];
+ }
+ return (h & 16r7fffffff) % n;
+}
+
+# the following two functions cheat by getting the caller
+# to calculate the actual hash function. this is to avoid
+# the hash function being calculated once in every scope
+# of a context until the variable is found (or stored).
+hashfind(ht: array of list of ref Var, idx: int, n: string): ref Var
+{
+ for (ent := ht[idx]; ent != nil; ent = tl ent)
+ if ((hd ent).name == n)
+ return hd ent;
+ return nil;
+}
+
+hashadd(ht: array of list of ref Var, idx: int, v: ref Var)
+{
+ ht[idx] = v :: ht[idx];
+}
+
+copylocalenv(e: ref Localenv): ref Localenv
+{
+ nvars := array[len e.vars] of list of ref Var;
+ flags := e.flags;
+ for (; e != nil; e = e.pushed)
+ for (i := 0; i < len nvars; i++)
+ for (vl := e.vars[i]; vl != nil; vl = tl vl) {
+ idx := hashfn((hd vl).name, len nvars);
+ if (hashfind(nvars, idx, (hd vl).name) == nil)
+ hashadd(nvars, idx, ref *(hd vl));
+ }
+ return ref Localenv(nvars, nil, flags);
+}
+
+# make new local environment. if it's got no pushed levels,
+# then get all variables from the global environment.
+newlocalenv(pushed: ref Localenv): ref Localenv
+{
+ e := ref Localenv(array[ENVHASHSIZE] of list of ref Var, pushed, 0);
+ if (pushed == nil && env != nil) {
+ for (vl := env->getall(); vl != nil; vl = tl vl) {
+ (name, val) := hd vl;
+ hashadd(e.vars, hashfn(name, len e.vars), ref Var(name, envstringtoval(val), 0));
+ }
+ }
+ if (pushed != nil)
+ e.flags = pushed.flags;
+ return e;
+}
+
+copybuiltins(b: ref Builtins): ref Builtins
+{
+ nb := ref Builtins(array[b.n] of (string, list of Shellbuiltin), b.n);
+ nb.ba[0:] = b.ba[0:b.n];
+ return nb;
+}
+
+findbuiltin(b: ref Builtins, name: string): (int, list of Shellbuiltin)
+{
+ lo := 0;
+ hi := b.n - 1;
+ while (lo <= hi) {
+ mid := (lo + hi) / 2;
+ (bname, bmod) := b.ba[mid];
+ if (name < bname)
+ hi = mid - 1;
+ else if (name > bname)
+ lo = mid + 1;
+ else
+ return (mid, bmod);
+ }
+ return (lo, nil);
+}
+
+removebuiltin(b: ref Builtins, name: string, mod: Shellbuiltin)
+{
+ (n, bmods) := findbuiltin(b, name);
+ if (bmods == nil)
+ return;
+ if (hd bmods == mod) {
+ if (tl bmods != nil)
+ b.ba[n] = (name, tl bmods);
+ else {
+ b.ba[n:] = b.ba[n+1:b.n];
+ b.ba[--b.n] = (nil, nil);
+ }
+ }
+}
+
+# add builtin; if it already exists, then replace it. if mod is nil then remove it.
+# builtins that refer to myselfbuiltin are special - they
+# are never removed, neither are they entirely replaced, only covered.
+# no external module can redefine the name "builtin"
+addbuiltin(b: ref Builtins, name: string, mod: Shellbuiltin)
+{
+ if (mod == nil || (name == "builtin" && mod != myselfbuiltin))
+ return;
+ (n, bmods) := findbuiltin(b, name);
+ if (bmods != nil) {
+ if (hd bmods == myselfbuiltin)
+ b.ba[n] = (name, mod :: bmods);
+ else
+ b.ba[n] = (name, mod :: nil);
+ } else {
+ if (b.n == len b.ba) {
+ nb := array[b.n + 10] of (string, list of Shellbuiltin);
+ nb[0:] = b.ba[0:b.n];
+ b.ba = nb;
+ }
+ b.ba[n+1:] = b.ba[n:b.n];
+ b.ba[n] = (name, mod :: nil);
+ b.n++;
+ }
+}
+
+removebuiltinmod(b: ref Builtins, mod: Shellbuiltin)
+{
+ j := 0;
+ for (i := 0; i < b.n; i++) {
+ (name, bmods) := b.ba[i];
+ if (hd bmods == mod)
+ bmods = tl bmods;
+ if (bmods != nil)
+ b.ba[j++] = (name, bmods);
+ }
+ b.n = j;
+ for (; j < i; j++)
+ b.ba[j] = (nil, nil);
+}
+
+export(e: ref Localenv)
+{
+ if (env == nil)
+ return;
+ if (e.pushed != nil)
+ export(e.pushed);
+
+ for (i := 0; i < len e.vars; i++) {
+ for (vl := e.vars[i]; vl != nil; vl = tl vl) {
+ v := hd vl;
+ # a bit inefficient: a local variable will get several putenvs.
+ if ((v.flags & Var.CHANGED) && !(v.flags & Var.NOEXPORT)) {
+ setenv(v.name, v.val);
+ v.flags &= ~Var.CHANGED;
+ }
+ }
+ }
+}
+
+noexport(name: string): int
+{
+ case name {
+ "0" or "*" or "status" => return 1;
+ }
+ return 0;
+}
+
+index(val: list of ref Listnode, k: int): list of ref Listnode
+{
+ for (; k > 0 && val != nil; k--)
+ val = tl val;
+ if (val != nil)
+ val = hd val :: nil;
+ return val;
+}
+
+getenv(name: string): list of ref Listnode
+{
+ if (env == nil)
+ return nil;
+ return envstringtoval(env->getenv(name));
+}
+
+envstringtoval(v: string): list of ref Listnode
+{
+ return stringlist2list(str->unquoted(v));
+}
+
+XXXenvstringtoval(v: string): list of ref Listnode
+{
+ if (len v == 0)
+ return nil;
+ start := len v;
+ val: list of ref Listnode;
+ for (i := start - 1; i >= 0; i--) {
+ if (v[i] == ENVSEP) {
+ val = ref Listnode(nil, v[i+1:start]) :: val;
+ start = i;
+ }
+ }
+ return ref Listnode(nil, v[0:start]) :: val;
+}
+
+setenv(name: string, val: list of ref Listnode)
+{
+ if (env == nil)
+ return;
+ env->setenv(name, quoted(val, 1));
+}
+
+#
+# globbing and general wildcard handling
+#
+
+containswildchar(s: string): int
+{
+ # try and avoid being fooled by GLOB characters in quoted
+ # text. we'll only be fooled if the GLOB char is followed
+ # by a wildcard char, or another GLOB.
+ for (i := 0; i < len s; i++) {
+ if (s[i] == GLOB && i < len s - 1) {
+ case s[i+1] {
+ '*' or '[' or '?' or GLOB =>
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
+
+# remove GLOBs, and quote other wildcard characters
+patquote(word: string): string
+{
+ outword := "";
+ for (i := 0; i < len word; i++) {
+ case word[i] {
+ '[' or '*' or '?' or '\\' =>
+ outword[len outword] = '\\';
+ GLOB =>
+ i++;
+ if (i >= len word)
+ return outword;
+ }
+ outword[len outword] = word[i];
+ }
+ return outword;
+}
+
+# get rid of GLOB characters
+deglob(s: string): string
+{
+ j := 0;
+ for (i := 0; i < len s; i++) {
+ if (s[i] != GLOB) {
+ if (i != j) # a worthy optimisation???
+ s[j] = s[i];
+ j++;
+ }
+ }
+ if (i == j)
+ return s;
+ return s[0:j];
+}
+
+# expand wildcards in _nl_
+glob(nl: list of ref Listnode): list of ref Listnode
+{
+ new: list of ref Listnode;
+ while (nl != nil) {
+ n := hd nl;
+ if (containswildchar(n.word)) {
+ qword := patquote(n.word);
+ files := filepat->expand(qword);
+ if (files == nil)
+ files = deglob(n.word) :: nil;
+ while (files != nil) {
+ new = ref Listnode(nil, hd files) :: new;
+ files = tl files;
+ }
+ } else
+ new = n :: new;
+ nl = tl nl;
+ }
+ ret := revlist(new);
+ return ret;
+}
+
+#
+# general list manipulation utility routines
+#
+
+# return string equivalent of nl
+list2stringlist(nl: list of ref Listnode): list of string
+{
+ ret: list of string = nil;
+
+ while (nl != nil) {
+ newel: string;
+ el := hd nl;
+ if (el.word != nil || el.cmd == nil)
+ newel = el.word;
+ else
+ el.word = newel = cmd2string(el.cmd);
+ ret = newel::ret;
+ nl = tl nl;
+ }
+
+ sl := revstringlist(ret);
+ return sl;
+}
+
+stringlist2list(sl: list of string): list of ref Listnode
+{
+ ret: list of ref Listnode;
+
+ while (sl != nil) {
+ ret = ref Listnode(nil, hd sl) :: ret;
+ sl = tl sl;
+ }
+ return revlist(ret);
+}
+
+revstringlist(l: list of string): list of string
+{
+ t: list of string;
+
+ while(l != nil) {
+ t = hd l :: t;
+ l = tl l;
+ }
+ return t;
+}
+
+revlist(l: list of ref Listnode): list of ref Listnode
+{
+ t: list of ref Listnode;
+
+ while(l != nil) {
+ t = hd l :: t;
+ l = tl l;
+ }
+ return t;
+}
+
+#
+# node to string conversion functions
+#
+
+fdassignstr(isassign: int, redir: ref Redir): string
+{
+ l: string = nil;
+ if (redir.fd1 >= 0)
+ l = string redir.fd1;
+
+ if (isassign) {
+ r: string = nil;
+ if (redir.fd2 >= 0)
+ r = string redir.fd2;
+ return "[" + l + "=" + r + "]";
+ }
+ return "[" + l + "]";
+}
+
+redirstr(rtype: int): string
+{
+ case rtype {
+ * or
+ Sys->OREAD => return "<";
+ Sys->OWRITE => return ">";
+ Sys->OWRITE|OAPPEND => return ">>";
+ Sys->ORDWR => return "<>";
+ }
+}
+
+cmd2string(n: ref Node): string
+{
+ if (n == nil)
+ return "";
+
+ s: string;
+ case n.ntype {
+ n_BLOCK => s = "{" + cmd2string(n.left) + "}";
+ n_VAR => s = "$" + cmd2string(n.left);
+ # XXX can this ever occur?
+ if (n.right != nil)
+ s += "(" + cmd2string(n.right) + ")";
+ n_SQUASH => s = "$\"" + cmd2string(n.left);
+ n_COUNT => s = "$#" + cmd2string(n.left);
+ n_BQ => s = "`" + cmd2string(n.left);
+ n_BQ2 => s = "\"" + cmd2string(n.left);
+ n_REDIR => s = redirstr(n.redir.rtype);
+ if (n.redir.fd1 != -1)
+ s += fdassignstr(0, n.redir);
+ s += cmd2string(n.left);
+ n_DUP => s = redirstr(n.redir.rtype) + fdassignstr(1, n.redir);
+ n_LIST => s = "(" + cmd2string(n.left) + ")";
+ n_SEQ => s = cmd2string(n.left) + ";" + cmd2string(n.right);
+ n_NOWAIT => s = cmd2string(n.left) + "&";
+ n_CONCAT => s = cmd2string(n.left) + "^" + cmd2string(n.right);
+ n_PIPE => s = cmd2string(n.left) + "|";
+ if (n.redir != nil && (n.redir.fd1 != -1 || n.redir.fd2 != -1))
+ s += fdassignstr(n.redir.fd2 != -1, n.redir);
+ s += cmd2string(n.right);
+ n_ASSIGN => s = cmd2string(n.left) + "=" + cmd2string(n.right);
+ n_LOCAL => s = cmd2string(n.left) + ":=" + cmd2string(n.right);
+ n_ADJ => s = cmd2string(n.left) + " " + cmd2string(n.right);
+ n_WORD => s = quote(n.word, 1);
+ * => s = sys->sprint("unknown%d", n.ntype);
+ }
+ return s;
+}
+
+# convert s into a suitable format for reparsing.
+# if glob is true, then GLOB chars are significant.
+# XXX it might be faster in the more usual cases
+# to run through the string first and only build up
+# a new string once we've discovered it's necessary.
+quote(s: string, glob: int): string
+{
+ needquote := 0;
+ t := "";
+ for (i := 0; i < len s; i++) {
+ case s[i] {
+ '{' or '}' or '(' or ')' or '`' or '&' or ';' or '=' or '>' or '<' or '#' or
+ '|' or '*' or '[' or '?' or '$' or '^' or ' ' or '\t' or '\n' or '\r' =>
+ needquote = 1;
+ '\'' =>
+ t[len t] = '\'';
+ needquote = 1;
+ GLOB =>
+ if (glob) {
+ if (i < len s - 1)
+ i++;
+ }
+ }
+ t[len t] = s[i];
+ }
+ if (needquote || t == nil)
+ t = "'" + t + "'";
+ return t;
+}
+
+squash(l: list of string, sep: string): string
+{
+ if (l == nil)
+ return nil;
+ s := hd l;
+ for (l = tl l; l != nil; l = tl l)
+ s += sep + hd l;
+ return s;
+}
+
+debug(s: string)
+{
+ if (DEBUG) sys->fprint(stderr(), "%s\n", string sys->pctl(0, nil) + ": " + s);
+}
+
+#
+# built-in commands
+#
+
+initbuiltin(c: ref Context, nil: Sh): string
+{
+ names := array[] of {"load", "unload", "loaded", "builtin", "syncenv", "whatis", "run", "exit", "@"};
+ for (i := 0; i < len names; i++)
+ c.addbuiltin(names[i], myselfbuiltin);
+ c.addsbuiltin("loaded", myselfbuiltin);
+ c.addsbuiltin("quote", myselfbuiltin);
+ c.addsbuiltin("bquote", myselfbuiltin);
+ c.addsbuiltin("unquote", myselfbuiltin);
+ c.addsbuiltin("builtin", myselfbuiltin);
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+runsbuiltin(ctxt: ref Context, nil: Sh, argv: list of ref Listnode): list of ref Listnode
+{
+ case (hd argv).word {
+ "loaded" => return sbuiltin_loaded(ctxt, argv);
+ "bquote" => return sbuiltin_quote(ctxt, argv, 0);
+ "quote" => return sbuiltin_quote(ctxt, argv, 1);
+ "unquote" => return sbuiltin_unquote(ctxt, argv);
+ "builtin" => return sbuiltin_builtin(ctxt, argv);
+ }
+ return nil;
+}
+
+runbuiltin(ctxt: ref Context, nil: Sh, args: list of ref Listnode, lseq: int): string
+{
+ status := "";
+ name := (hd args).word;
+ case name {
+ "load" => status = builtin_load(ctxt, args, lseq);
+ "loaded" => status = builtin_loaded(ctxt, args, lseq);
+ "unload" => status = builtin_unload(ctxt, args, lseq);
+ "builtin" => status = builtin_builtin(ctxt, args, lseq);
+ "whatis" => status = builtin_whatis(ctxt, args, lseq);
+ "run" => status = builtin_run(ctxt, args, lseq);
+ "exit" => status = builtin_exit(ctxt, args, lseq);
+ "syncenv" => export(ctxt.env.localenv);
+ "@" => status = builtin_subsh(ctxt, args, lseq);
+ }
+ return status;
+}
+
+sbuiltin_loaded(ctxt: ref Context, nil: list of ref Listnode): list of ref Listnode
+{
+ v: list of ref Listnode;
+ for (bl := ctxt.env.bmods; bl != nil; bl = tl bl) {
+ (name, nil) := hd bl;
+ v = ref Listnode(nil, name) :: v;
+ }
+ return v;
+}
+
+sbuiltin_quote(nil: ref Context, argv: list of ref Listnode, quoteblocks: int): list of ref Listnode
+{
+ return ref Listnode(nil, quoted(tl argv, quoteblocks)) :: nil;
+}
+
+sbuiltin_builtin(ctxt: ref Context, args: list of ref Listnode): list of ref Listnode
+{
+ if (args == nil || tl args == nil)
+ builtinusage(ctxt, "builtin command [args ...]");
+ name := (hd tl args).word;
+ (nil, mods) := findbuiltin(ctxt.env.sbuiltins, name);
+ for (; mods != nil; mods = tl mods)
+ if (hd mods == myselfbuiltin)
+ return (hd mods)->runsbuiltin(ctxt, myself, tl args);
+ ctxt.fail("builtin not found", sys->sprint("sh: builtin %s not found", name));
+ return nil;
+}
+
+sbuiltin_unquote(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ argv = tl argv;
+ if (argv == nil || tl argv != nil)
+ builtinusage(ctxt, "unquote arg");
+
+ arg := (hd argv).word;
+ if (arg == nil && (hd argv).cmd != nil)
+ arg = cmd2string((hd argv).cmd);
+ return stringlist2list(str->unquoted(arg));
+}
+
+getself(): Shellbuiltin
+{
+ return myselfbuiltin;
+}
+
+builtinusage(ctxt: ref Context, s: string)
+{
+ ctxt.fail("usage", "sh: usage: " + s);
+}
+
+builtin_exit(nil: ref Context, nil: list of ref Listnode, nil: int): string
+{
+ # XXX using this primitive can cause
+ # environment stack not to be popped properly.
+ exit;
+}
+
+builtin_subsh(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args == nil)
+ return nil;
+ startchan := chan of (int, ref Expropagate);
+ spawn runasync(ctxt, 0, tl args, ref Redirlist, startchan);
+ (exepid, exprop) := <-startchan;
+ status := waitfor(ctxt, exepid :: nil);
+ if (exprop.name != nil)
+ raise exprop.name;
+ return status;
+}
+
+builtin_loaded(ctxt: ref Context, nil: list of ref Listnode, nil: int): string
+{
+ b := ctxt.env.builtins;
+ for (i := 0; i < b.n; i++) {
+ (name, bmods) := b.ba[i];
+ sys->print("%s\t%s\n", name, modname(ctxt, hd bmods));
+ }
+ b = ctxt.env.sbuiltins;
+ for (i = 0; i < b.n; i++) {
+ (name, bmods) := b.ba[i];
+ sys->print("${%s}\t%s\n", name, modname(ctxt, hd bmods));
+ }
+ return nil;
+}
+
+# it's debateable whether this should throw an exception or
+# return a failed exit status - however, most scripts don't
+# check the status and do need the module they're loading,
+# so i think the exception is probably more useful...
+builtin_load(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args == nil || (hd tl args).word == nil)
+ builtinusage(ctxt, "load path...");
+ args = tl args;
+ path := (hd args).word;
+ if (args == nil)
+ builtinusage(ctxt, "load path...");
+ status := "";
+ for (; args != nil; args = tl args) {
+ s := loadmodule(ctxt, (hd args).word);
+ if (s != nil)
+ raise "fail:" + s;
+ }
+ return nil;
+}
+
+builtin_unload(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args == nil)
+ builtinusage(ctxt, "unload path...");
+ status := "";
+ for (args = tl args; args != nil; args = tl args)
+ if ((s := unloadmodule(ctxt, (hd args).word)) != nil)
+ status = s;
+ return status;
+}
+
+builtin_run(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args == nil || (hd tl args).word == nil)
+ builtinusage(ctxt, "run path");
+ ctxt.push();
+ {
+ ctxt.setoptions(ctxt.INTERACTIVE, 0);
+ runscript(ctxt, (hd tl args).word, tl tl args, 1);
+ ctxt.pop();
+ return nil;
+ } exception e {
+ "fail:*" =>
+ ctxt.pop();
+ return e[5:];
+ }
+}
+
+# four categories:
+# environment variables
+# substitution builtins
+# braced blocks
+# builtins (including those defined by externally loaded modules)
+# or external programs
+# other
+builtin_whatis(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (len args < 2)
+ builtinusage(ctxt, "whatis name ...");
+ err := "";
+ for (args = tl args; args != nil; args = tl args)
+ if ((e := whatisit(ctxt, hd args)) != nil)
+ err = e;
+ return err;
+}
+
+whatisit(ctxt: ref Context, el: ref Listnode): string
+{
+ if (el.cmd != nil) {
+ sys->print("%s\n", cmd2string(el.cmd));
+ return nil;
+ }
+ found := 0;
+ name := el.word;
+ if (name != nil && name[0] == '{') { #}
+ sys->print("%s\n", name);
+ return nil;;
+ }
+ if (name == nil)
+ return nil; # XXX questionable
+ w: string;
+ val := ctxt.get(name);
+ if (val != nil) {
+ found++;
+ w += sys->sprint("%s=%s\n", quote(name, 0), quoted(val, 0));
+ }
+ (nil, mods) := findbuiltin(ctxt.env.sbuiltins, name);
+ if (mods != nil) {
+ mod := hd mods;
+ if (mod == myselfbuiltin)
+ w += "${builtin " + name + "}\n";
+ else {
+ mw := mod->whatis(ctxt, myself, name, Shellbuiltin->SBUILTIN);
+ if (mw == nil)
+ mw = "${" + name + "}";
+ w += "load " + modname(ctxt, mod) + "; " + mw + "\n";
+ }
+ found++;
+ }
+ (nil, mods) = findbuiltin(ctxt.env.builtins, name);
+ if (mods != nil) {
+ mod := hd mods;
+ if (mod == myselfbuiltin)
+ sys->print("builtin %s\n", name);
+ else {
+ mw := mod->whatis(ctxt, myself, name, Shellbuiltin->BUILTIN);
+ if (mw == nil)
+ mw = name;
+ w += "load " + modname(ctxt, mod) + "; " + mw + "\n";
+ }
+ found++;
+ } else {
+ disfile := 0;
+ if (len name >= 4 && name[len name-4:] == ".dis")
+ disfile = 1;
+ pathlist: list of string;
+ if (len name >= 2 && (name[0] == '/' || name[0:2] == "./"))
+ pathlist = list of {""};
+ else if ((pl := ctxt.get("path")) != nil)
+ pathlist = list2stringlist(pl);
+ else
+ pathlist = list of {"/dis", "."};
+
+ foundpath := "";
+ while (pathlist != nil) {
+ path: string;
+ if (hd pathlist != "")
+ path = hd pathlist + "/" + name;
+ else
+ path = name;
+ if (!disfile && (fd := sys->open(path, Sys->OREAD)) != nil) {
+ if (executable(sys->fstat(fd), 8r111)) {
+ foundpath = path;
+ break;
+ }
+ }
+ if (!disfile)
+ path += ".dis";
+ if (executable(sys->stat(path), 8r444)) {
+ foundpath = path;
+ break;
+ }
+ pathlist = tl pathlist;
+ }
+ if (foundpath != nil)
+ w += foundpath + "\n";
+ }
+ for (bmods := ctxt.env.bmods; bmods != nil; bmods = tl bmods) {
+ (modname, mod) := hd bmods;
+ if ((mw := mod->whatis(ctxt, myself, name, Shellbuiltin->OTHER)) != nil)
+ w += "load " + modname + "; " + mw + "\n";
+ }
+ if (w == nil) {
+ sys->fprint(stderr(), "%s: not found\n", name);
+ return "not found";
+ }
+ sys->print("%s", w);
+ return nil;
+}
+
+# execute a command ignoring names defined by externally defined modules
+builtin_builtin(ctxt: ref Context, args: list of ref Listnode, last: int): string
+{
+ if (len args < 2)
+ builtinusage(ctxt, "builtin command [args ...]");
+ name := (hd tl args).word;
+ if (name == nil || name[0] == '{') {
+ diagnostic(ctxt, name + " not found");
+ return "not found";
+ }
+ (nil, mods) := findbuiltin(ctxt.env.builtins, name);
+ for (; mods != nil; mods = tl mods)
+ if (hd mods == myselfbuiltin)
+ return (hd mods)->runbuiltin(ctxt, myself, tl args, last);
+ if (ctxt.options() & ctxt.EXECPRINT)
+ sys->fprint(stderr(), "%s\n", quoted(tl args, 0));
+ return runexternal(ctxt, tl args, last);
+}
+
+modname(ctxt: ref Context, mod: Shellbuiltin): string
+{
+ for (ml := ctxt.env.bmods; ml != nil; ml = tl ml) {
+ (bname, bmod) := hd ml;
+ if (bmod == mod)
+ return bname;
+ }
+ return "builtin";
+}
+
+loadmodule(ctxt: ref Context, name: string): string
+{
+ # avoid loading the same module twice (it's convenient
+ # to have load be a null-op if the module required is already loaded)
+ for (bl := ctxt.env.bmods; bl != nil; bl = tl bl) {
+ (bname, nil) := hd bl;
+ if (bname == name)
+ return nil;
+ }
+ path := name;
+ if (len path < 4 || path[len path-4:] != ".dis")
+ path += ".dis";
+ if (path[0] != '/' && path[0:2] != "./")
+ path = BUILTINPATH + "/" + path;
+ mod := load Shellbuiltin path;
+ if (mod == nil) {
+ diagnostic(ctxt, sys->sprint("load: cannot load %s: %r", path));
+ return "bad module";
+ }
+ s := mod->initbuiltin(ctxt, myself);
+ ctxt.env.bmods = (name, mod->getself()) :: ctxt.env.bmods;
+ if (s != nil) {
+ unloadmodule(ctxt, name);
+ diagnostic(ctxt, "load: module init failed: " + s);
+ }
+ return s;
+}
+
+unloadmodule(ctxt: ref Context, name: string): string
+{
+ bl: list of (string, Shellbuiltin);
+ mod: Shellbuiltin;
+ for (cl := ctxt.env.bmods; cl != nil; cl = tl cl) {
+ (bname, bmod) := hd cl;
+ if (bname == name)
+ mod = bmod;
+ else
+ bl = hd cl :: bl;
+ }
+ if (mod == nil) {
+ diagnostic(ctxt, sys->sprint("module %s not found", name));
+ return "not found";
+ }
+ for (ctxt.env.bmods = nil; bl != nil; bl = tl bl)
+ ctxt.env.bmods = hd bl :: ctxt.env.bmods;
+ removebuiltinmod(ctxt.env.builtins, mod);
+ removebuiltinmod(ctxt.env.sbuiltins, mod);
+ return nil;
+}
+
+executable(s: (int, Sys->Dir), mode: int): int
+{
+ (ok, info) := s;
+ return ok != -1 && (info.mode & Sys->DMDIR) == 0
+ && (info.mode & mode) != 0;
+}
+
+quoted(val: list of ref Listnode, quoteblocks: int): string
+{
+ s := "";
+ for (; val != nil; val = tl val) {
+ el := hd val;
+ if (el.cmd == nil || (quoteblocks && el.word != nil))
+ s += quote(el.word, 0);
+ else {
+ cmd := cmd2string(el.cmd);
+ if (quoteblocks)
+ cmd = quote(cmd, 0);
+ s += cmd;
+ }
+ if (tl val != nil)
+ s[len s] = ' ';
+ }
+ return s;
+}
+
+setstatus(ctxt: ref Context, val: string): string
+{
+ ctxt.setlocal("status", ref Listnode(nil, val) :: nil);
+ return val;
+}
+
+#
+# beginning of parser routines
+#
+
+doparse(l: ref YYLEX, prompt: string, showline: int): (ref Node, string)
+{
+ l.prompt = prompt;
+ l.err = nil;
+ l.lval.node = nil;
+ yyparse(l);
+ l.lastnl = 0; # don't print secondary prompt next time
+ if (l.err != nil) {
+ s: string;
+ if (l.err == nil)
+ l.err = "unknown error";
+ if (l.errline > 0 && showline)
+ s = sys->sprint("%s:%d: %s", l.path, l.errline, l.err);
+ else
+ s = l.path + ": parse error: " + l.err;
+ return (nil, s);
+ }
+ return (l.lval.node, nil);
+}
+
+blanklex: YYLEX; # for hassle free zero initialisation
+
+YYLEX.initstring(s: string): ref YYLEX
+{
+ ret := ref blanklex;
+ ret.s = s;
+ ret.path="internal";
+ ret.strpos = 0;
+ return ret;
+}
+
+YYLEX.initfile(fd: ref Sys->FD, path: string): ref YYLEX
+{
+ lex := ref blanklex;
+ lex.f = bufio->fopen(fd, bufio->OREAD);
+ lex.path = path;
+ lex.cbuf = array[2] of int; # number of characters of pushback
+ lex.linenum = 1;
+ lex.prompt = "";
+ return lex;
+}
+
+YYLEX.error(l: self ref YYLEX, s: string)
+{
+ if (l.err == nil) {
+ l.err = s;
+ l.errline = l.linenum;
+ }
+}
+
+NOTOKEN: con -1;
+
+YYLEX.lex(l: self ref YYLEX): int
+{
+ # the following are allowed a free caret:
+ # $, word and quoted word;
+ # also, allowed chrs in unquoted word following dollar are [a-zA-Z0-9*_]
+ endword := 0;
+ wasdollar := 0;
+ tok := NOTOKEN;
+ while (tok == NOTOKEN) {
+ case c := l.getc() {
+ l.EOF =>
+ tok = END;
+ '\n' =>
+ tok = '\n';
+ '\r' or '\t' or ' ' =>
+ ;
+ '#' =>
+ while ((c = l.getc()) != '\n' && c != l.EOF)
+ ;
+ l.ungetc();
+ ';' => tok = ';';
+ '&' =>
+ c = l.getc();
+ if(c == '&')
+ tok = ANDAND;
+ else{
+ l.ungetc();
+ tok = '&';
+ }
+ '^' => tok = '^';
+ '{' => tok = '{';
+ '}' => tok = '}';
+ ')' => tok = ')';
+ '(' => tok = '(';
+ '=' => (tok, l.lval.optype) = ('=', n_ASSIGN);
+ '$' =>
+ if (l.atendword) {
+ l.ungetc();
+ tok = '^';
+ break;
+ }
+ case (c = l.getc()) {
+ '#' =>
+ l.lval.optype = n_COUNT;
+ '"' =>
+ l.lval.optype = n_SQUASH;
+ * =>
+ l.ungetc();
+ l.lval.optype = n_VAR;
+ }
+ tok = OP;
+ wasdollar = 1;
+ '"' or '`'=>
+ if (l.atendword) {
+ tok = '^';
+ l.ungetc();
+ break;
+ }
+ tok = OP;
+ if (c == '"')
+ l.lval.optype = n_BQ2;
+ else
+ l.lval.optype = n_BQ;
+ '>' or '<' =>
+ rtype: int;
+ nc := l.getc();
+ if (nc == '>') {
+ if (c == '>')
+ rtype = Sys->OWRITE | OAPPEND;
+ else
+ rtype = Sys->ORDWR;
+ nc = l.getc();
+ } else if (c == '>')
+ rtype = Sys->OWRITE;
+ else
+ rtype = Sys->OREAD;
+ tok = REDIR;
+ if (nc == '[') {
+ (tok, l.lval.redir) = readfdassign(l);
+ if (tok == ERROR)
+ (l.err, l.errline) = ("syntax error in redirection", l.linenum);
+ } else {
+ l.ungetc();
+ l.lval.redir = ref Redir(-1, -1, -1);
+ }
+ if (l.lval.redir != nil)
+ l.lval.redir.rtype = rtype;
+ '|' =>
+ tok = '|';
+ l.lval.redir = nil;
+ if ((c = l.getc()) == '[') {
+ (tok, l.lval.redir) = readfdassign(l);
+ if (tok == ERROR) {
+ (l.err, l.errline) = ("syntax error in pipe redirection", l.linenum);
+ return tok;
+ }
+ tok = '|';
+ } else if(c == '|')
+ tok = OROR;
+ else
+ l.ungetc();
+
+ '\'' =>
+ if (l.atendword) {
+ l.ungetc();
+ tok = '^';
+ break;
+ }
+ startline := l.linenum;
+ s := "";
+ for(;;) {
+ while ((nc := l.getc()) != '\'' && nc != l.EOF)
+ s[len s] = nc;
+ if (nc == l.EOF) {
+ (l.err, l.errline) = ("unterminated string literal", startline);
+ return ERROR;
+ }
+ if (l.getc() != '\'') {
+ l.ungetc();
+ break;
+ }
+ s[len s] = '\''; # 'xxx''yyy' becomes WORD(xxx'yyy)
+ }
+ l.lval.word = s;
+ tok = WORD;
+ endword = 1;
+
+ * =>
+ if (c == ':') {
+ if (l.getc() == '=') {
+ tok = '=';
+ l.lval.optype = n_LOCAL;
+ break;
+ }
+ l.ungetc();
+ }
+ if (l.atendword) {
+ l.ungetc();
+ tok = '^';
+ break;
+ }
+ allowed: string;
+ if (l.wasdollar)
+ allowed = "a-zA-Z0-9*_";
+ else
+ allowed = "^\n \t\r|$'#<>;^(){}`&=\"";
+ word := "";
+ loop: do {
+ case c {
+ '*' or '?' or '[' or GLOB =>
+ word[len word] = GLOB;
+ ':' =>
+ nc := l.getc();
+ l.ungetc();
+ if (nc == '=')
+ break loop;
+ }
+ word[len word] = c;
+ } while ((c = l.getc()) != l.EOF && str->in(c, allowed));
+ l.ungetc();
+ l.lval.word = word;
+ tok = WORD;
+ endword = 1;
+ }
+ l.atendword = endword;
+ l.wasdollar = wasdollar;
+ }
+# sys->print("token %s\n", tokstr(tok));
+ return tok;
+}
+
+tokstr(t: int): string
+{
+ s: string;
+ case t {
+ '\n' => s = "'\\n'";
+ 33 to 127 => s = sprint("'%c'", t);
+ DUP=> s = "DUP";
+ REDIR =>s = "REDIR";
+ WORD => s = "WORD";
+ OP => s = "OP";
+ END => s = "END";
+ ERROR=> s = "ERROR";
+ * =>
+ s = "<unknowntok"+ string t + ">";
+ }
+ return s;
+}
+
+YYLEX.ungetc(lex: self ref YYLEX)
+{
+ lex.strpos--;
+ if (lex.f != nil) {
+ lex.ncbuf++;
+ if (lex.strpos < 0)
+ lex.strpos = len lex.cbuf - 1;
+ }
+}
+
+YYLEX.getc(lex: self ref YYLEX): int
+{
+ if (lex.eof) # EOF sticks
+ return lex.EOF;
+ c: int;
+ if (lex.f != nil) {
+ if (lex.ncbuf > 0) {
+ c = lex.cbuf[lex.strpos++];
+ if (lex.strpos >= len lex.cbuf)
+ lex.strpos = 0;
+ lex.ncbuf--;
+ } else {
+ if (lex.lastnl && lex.prompt != nil)
+ sys->fprint(stderr(), "%s", lex.prompt);
+ c = bufio->lex.f.getc();
+ if (c == bufio->ERROR || c == bufio->EOF) {
+ lex.eof = 1;
+ c = lex.EOF;
+ } else if (c == '\n')
+ lex.linenum++;
+ lex.lastnl = (c == '\n');
+ lex.cbuf[lex.strpos++] = c;
+ if (lex.strpos >= len lex.cbuf)
+ lex.strpos = 0;
+ }
+ } else {
+ if (lex.strpos >= len lex.s) {
+ lex.eof = 1;
+ c = lex.EOF;
+ } else
+ c = lex.s[lex.strpos++];
+ }
+ return c;
+}
+
+# read positive decimal number; return -1 if no number found.
+readnum(lex: ref YYLEX): int
+{
+ sum := nc := 0;
+ while ((c := lex.getc()) >= '0' && c <= '9') {
+ sum = (sum * 10) + (c - '0');
+ nc++;
+ }
+ lex.ungetc();
+ if (nc == 0)
+ return -1;
+ return sum;
+}
+
+# return tuple (toktype, lhs, rhs).
+# -1 signifies no number present.
+# '[' char has already been read.
+readfdassign(lex: ref YYLEX): (int, ref Redir)
+{
+ n1 := readnum(lex);
+ if ((c := lex.getc()) != '=') {
+ if (c == ']')
+ return (REDIR, ref Redir(-1, n1, -1));
+
+ return (ERROR, nil);
+ }
+ n2 := readnum(lex);
+ if (lex.getc() != ']')
+ return (ERROR, nil);
+ return (DUP, ref Redir(-1, n1, n2));
+}
+
+mkseq(left, right: ref Node): ref Node
+{
+ if (left != nil && right != nil)
+ return mk(n_SEQ, left, right);
+ else if (left == nil)
+ return right;
+ return left;
+}
+
+mk(ntype: int, left, right: ref Node): ref Node
+{
+ return ref Node(ntype, left, right, nil, nil);
+}
+
+stderr(): ref Sys->FD
+{
+ return sys->fildes(2);
+}
diff --git a/appl/cmd/sh/std.b b/appl/cmd/sh/std.b
new file mode 100644
index 00000000..6a944614
--- /dev/null
+++ b/appl/cmd/sh/std.b
@@ -0,0 +1,812 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+include "filepat.m";
+ filepat: Filepat;
+include "bufio.m";
+ bufio: Bufio;
+ Iobuf: import bufio;
+
+builtinnames := array[] of {
+ "if", "while", "~", "!", "apply", "for",
+ "status", "pctl", "fn", "subfn", "and", "or",
+ "raise", "rescue", "flag", "getlines", "no",
+};
+
+sbuiltinnames := array[] of {
+ "hd", "tl", "index", "split", "join", "pid", "parse", "env", "pipe",
+};
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("std: cannot load self: %r"));
+ filepat = load Filepat Filepat->PATH;
+ if (filepat == nil)
+ ctxt.fail("bad module",
+ sys->sprint("std: cannot load: %s: %r", Filepat->PATH));
+ bufio = load Bufio Bufio->PATH;
+ if (bufio == nil)
+ ctxt.fail("bad module",
+ sys->sprint("std: cannot load: %s: %r", Bufio->PATH));
+ names := builtinnames;
+ for (i := 0; i < len names; i++)
+ ctxt.addbuiltin(names[i], myself);
+ names = sbuiltinnames;
+ for (i = 0; i < len names; i++)
+ ctxt.addsbuiltin(names[i], myself);
+ env := ctxt.envlist();
+ for (; env != nil; env = tl env) {
+ (name, val) := hd env;
+ if (len name > 3 && name[0:3] == "fn-")
+ fndef(ctxt, name[3:], val, 0);
+ if (len name > 4 && name[0:4] == "sfn-")
+ fndef(ctxt, name[4:], val, 1);
+ }
+ return nil;
+}
+
+whatis(c: ref Sh->Context, sh: Sh, name: string, wtype: int): string
+{
+ ename, fname: string;
+ case wtype {
+ BUILTIN =>
+ (ename, fname) = ("fn-", "fn ");
+ SBUILTIN =>
+ (ename, fname) = ("sfn-", "subfn ");
+ OTHER =>
+ return nil;
+ }
+
+ val := c.get(ename + name);
+ if (val != nil)
+ return fname + name + " " + sh->quoted(hd val :: nil, 0);
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(c: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode, last: int): string
+{
+ status: string;
+ name := (hd cmd).word;
+ val := c.get("fn-" + name);
+ if (val != nil)
+ return c.run(hd val :: tl cmd, last);
+ case name {
+ "if" => status = builtin_if(c, cmd, last);
+ "while" => status = builtin_while(c, cmd, last);
+ "and" => status = builtin_and(c, cmd, last);
+ "apply" => status = builtin_apply(c, cmd, last);
+ "for" => status = builtin_for(c, cmd, last);
+ "or" => status = builtin_or(c, cmd, last);
+ "!" => status = builtin_not(c, cmd, last);
+ "fn" => status = builtin_fn(c, cmd, last, 0);
+ "subfn" => status = builtin_fn(c, cmd, last, 1);
+ "~" => status = builtin_twiddle(c, cmd, last);
+ "status" => status = builtin_status(c, cmd, last);
+ "pctl" => status = builtin_pctl(c, cmd, last);
+ "raise" => status = builtin_raise(c, cmd, last);
+ "rescue" => status = builtin_rescue(c, cmd, last);
+ "flag" => status = builtin_flag(c, cmd, last);
+ "getlines" => status = builtin_getlines(c, cmd, last);
+ "no" => status = builtin_no(c, cmd, last);
+ }
+ return status;
+}
+
+runsbuiltin(c: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode): list of ref Listnode
+{
+ name := (hd cmd).word;
+ val := c.get("sfn-" + name);
+ if (val != nil)
+ return runsubfn(c, val, tl cmd);
+ case name {
+ "pid" =>
+ return ref Listnode(nil, string sys->pctl(0, nil)) :: nil;
+ "hd" =>
+ if (tl cmd == nil)
+ return nil;
+ return hd tl cmd :: nil;
+ "tl" =>
+ if (tl cmd == nil)
+ return nil;
+ return tl tl cmd;
+ "index" =>
+ return sbuiltin_index(c, cmd);
+ "split" =>
+ return sbuiltin_split(c, cmd);
+ "join" =>
+ return sbuiltin_join(c, cmd);
+ "parse" =>
+ return sbuiltin_parse(c, cmd);
+ "env" =>
+ return sbuiltin_env(c, cmd);
+ "pipe" =>
+ return sbuiltin_pipe(c, cmd);
+ }
+ return nil;
+}
+
+runsubfn(ctxt: ref Context, body, args: list of ref Listnode): list of ref Listnode
+{
+ if (body == nil)
+ return nil;
+ ctxt.push();
+ {
+ ctxt.setlocal("result", nil);
+ ctxt.run(hd body :: args, 0);
+ result := ctxt.get("result");
+ ctxt.pop();
+ return result;
+ } exception e {
+ "fail:*" =>
+ ctxt.pop();
+ raise e;
+ }
+}
+
+sbuiltin_index(ctxt: ref Context, val: list of ref Listnode): list of ref Listnode
+{
+ if (len val < 2 || (hd tl val).word == nil)
+ builtinusage(ctxt, "index num list");
+ k := int (hd tl val).word - 1;
+ val = tl tl val;
+ for (; k > 0 && val != nil; k--)
+ val = tl val;
+ if (val != nil)
+ val = hd val :: nil;
+ return val;
+}
+
+# return a parsed version of a string, raising a "parse error" exception if
+# it fails. the string must be a braced command block.
+sbuiltin_parse(ctxt: ref Context, args: list of ref Listnode): list of ref Listnode
+{
+ if (len args != 2)
+ builtinusage(ctxt, "parse arg");
+ args = tl args;
+ if ((hd args).cmd != nil)
+ return ref Listnode((hd args).cmd, nil) :: nil;
+ w := (hd args).word;
+ if (w == nil || w[0] != '{') #}
+ ctxt.fail("parse error", "parse: argument must be a braced block");
+ (n, err) := sh->parse(w);
+ if (err != nil)
+ ctxt.fail("parse error", "parse: " + err);
+ return ref Listnode(n, nil) :: nil;
+}
+
+sbuiltin_env(ctxt: ref Context, nil: list of ref Listnode): list of ref Listnode
+{
+ vl: list of string;
+ for (e := ctxt.envlist(); e != nil; e = tl e) {
+ (n, v) := hd e;
+ if (v != nil) # XXX this is debatable... someone might want to see null local vars.
+ vl = n :: vl;
+ }
+ return sh->stringlist2list(vl);
+}
+
+word(n: ref Listnode): string
+{
+ if (n.word != nil)
+ return n.word;
+ if (n.cmd != nil)
+ n.word = sh->cmd2string(n.cmd);
+ return n.word;
+}
+
+# usage: split [separators] value
+sbuiltin_split(ctxt: ref Context, args: list of ref Listnode): list of ref Listnode
+{
+ n := len args;
+ if (n < 2 || n > 3)
+ builtinusage(ctxt, "split [separators] value");
+ seps: string;
+ if (n == 2) {
+ ifs := ctxt.get("ifs");
+ if (ifs == nil)
+ ctxt.fail("usage", "split: $ifs not set");
+ seps = word(hd ifs);
+ } else {
+ args = tl args;
+ seps = word(hd args);
+ }
+ (nil, toks) := sys->tokenize(word(hd tl args), seps);
+ return sh->stringlist2list(toks);
+}
+
+sbuiltin_join(ctxt: ref Context, args: list of ref Listnode): list of ref Listnode
+{
+ args = tl args;
+ if (args == nil)
+ builtinusage(ctxt, "join separator [arg...]");
+ seps := word(hd args);
+ if (tl args == nil)
+ return ref Listnode(nil, nil) :: nil;
+ s := word(hd tl args);
+ for (args = tl tl args; args != nil; args = tl args)
+ s += seps + word(hd args);
+ return ref Listnode(nil, s) :: nil;
+}
+
+builtin_fn(ctxt: ref Context, args: list of ref Listnode, nil: int, issub: int): string
+{
+ n := len args;
+ title := (hd args).word;
+ if (n < 2)
+ builtinusage(ctxt, title + " [name...] [{body}]");
+ for (al := tl args; tl al != nil; al = tl al)
+ if ((hd al).cmd != nil)
+ builtinusage(ctxt, title + " [name...] [{body}]");
+ if ((hd al).cmd != nil) {
+ cmd := hd al :: nil;
+ for (al = tl args; tl al != nil; al = tl al)
+ fndef(ctxt, (hd al).word, cmd, issub);
+ } else {
+ for (al = tl args; al != nil; al = tl al)
+ fnundef(ctxt, (hd al).word, issub);
+ }
+ return nil;
+}
+
+fndef(ctxt: ref Context, name: string, cmd: list of ref Listnode, issub: int)
+{
+ if (cmd == nil)
+ return;
+ if (issub) {
+ ctxt.set("sfn-" + name, cmd);
+ ctxt.addsbuiltin(name, myself);
+ } else {
+ ctxt.set("fn-" + name, cmd);
+ ctxt.addbuiltin(name, myself);
+ }
+}
+
+fnundef(ctxt: ref Context, name: string, issub: int)
+{
+ if (issub) {
+ ctxt.set("sfn-" + name, nil);
+ ctxt.removesbuiltin(name, myself);
+ } else {
+ ctxt.set("fn-" + name, nil);
+ ctxt.removebuiltin(name, myself);
+ }
+}
+
+builtin_flag(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ n := len args;
+ if (n < 2 || n > 3 || len (hd tl args).word != 1)
+ builtinusage(ctxt, "flag [vxei] [+-]");
+ flag := (hd tl args).word[0];
+ p := "";
+ if (n == 3)
+ p = (hd tl tl args).word;
+ mask := 0;
+ case flag {
+ 'v' => mask = Context.VERBOSE;
+ 'x' => mask = Context.EXECPRINT;
+ 'e' => mask = Context.ERROREXIT;
+ 'i' => mask = Context.INTERACTIVE;
+ * => builtinusage(ctxt, "flag [vxei] [+-]");
+ }
+ case p {
+ "" => if (ctxt.options() & mask)
+ return nil;
+ return "not set";
+ "-" => ctxt.setoptions(mask, 0);
+ "+" => ctxt.setoptions(mask, 1);
+ * => builtinusage(ctxt, "flag [vxei] [+-]");
+ }
+ return nil;
+}
+
+builtin_no(nil: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args != nil)
+ return "yes";
+ return nil;
+}
+
+iscmd(n: ref Listnode): int
+{
+ return n.cmd != nil || (n.word != nil && n.word[0] == '{');
+}
+
+builtin_if(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ args = tl args;
+ nargs := len args;
+ if (nargs < 2)
+ builtinusage(ctxt, "if {cond} {action} [{cond} {action}]... [{elseaction}]");
+
+ status: string;
+ dolstar := ctxt.get("*");
+ while (args != nil) {
+ cmd: ref Listnode = nil;
+ if (tl args == nil) {
+ cmd = hd args;
+ args = tl args;
+ } else {
+ if (!iscmd(hd args))
+ builtinusage(ctxt, "if [{cond} {action}]... [{elseaction}]");
+
+ status = ctxt.run(hd args :: dolstar, 0);
+ if (status == nil) {
+ cmd = hd tl args;
+ args = nil;
+ } else
+ args = tl tl args;
+ setstatus(ctxt, status);
+ }
+ if (cmd != nil) {
+ if (!iscmd(cmd))
+ builtinusage(ctxt, "if [{cond} {action}]... [{elseaction}]");
+
+ status = ctxt.run(cmd :: dolstar, 0);
+ }
+ }
+ return status;
+}
+
+builtin_or(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ s: string;
+ dolstar := ctxt.get("*");
+ for (args = tl args; args != nil; args = tl args) {
+ if (!iscmd(hd args))
+ builtinusage(ctxt, "or [{cmd} ...]");
+ if ((s = ctxt.run(hd args :: dolstar, 0)) == nil)
+ return nil;
+ else
+ setstatus(ctxt, s);
+ }
+ return s;
+}
+
+builtin_and(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ dolstar := ctxt.get("*");
+ for (args = tl args; args != nil; args = tl args) {
+ if (!iscmd(hd args))
+ builtinusage(ctxt, "and [{cmd} ...]");
+ if ((s := ctxt.run(hd args :: dolstar, 0)) != nil)
+ return s;
+ else
+ setstatus(ctxt, nil);
+ }
+ return nil;
+}
+
+builtin_while(ctxt: ref Context, args: list of ref Listnode, nil: int) : string
+{
+ args = tl args;
+ if (len args != 2 || !iscmd(hd args) || !iscmd(hd tl args))
+ builtinusage(ctxt, "while {condition} {cmd}");
+
+ dolstar := ctxt.get("*");
+ cond := hd args :: dolstar;
+ action := hd tl args :: dolstar;
+ status := "";
+
+ for(;;){
+ {
+ while (ctxt.run(cond, 0) == nil)
+ status = setstatus(ctxt, ctxt.run(action, 0));
+ return status;
+ } exception e{
+ "fail:*" =>
+ if (loopexcept(e) == BREAK)
+ return status;
+ }
+ }
+}
+
+builtin_getlines(ctxt: ref Context, argv: list of ref Listnode, nil: int) : string
+{
+ n := len argv;
+ if (n < 2 || n > 3)
+ builtinusage(ctxt, "getlines [separators] {cmd}");
+ argv = tl argv;
+ seps := "\n";
+ if (n == 3) {
+ seps = word(hd argv);
+ argv = tl argv;
+ }
+ if (len seps == 0)
+ builtinusage(ctxt, "getlines [separators] {cmd}");
+ if (!iscmd(hd argv))
+ builtinusage(ctxt, "getlines [separators] {cmd}");
+ cmd := hd argv :: ctxt.get("*");
+ stdin := bufio->fopen(sys->fildes(0), Sys->OREAD);
+ if (stdin == nil)
+ ctxt.fail("bad input", sys->sprint("getlines: cannot open stdin: %r"));
+ status := "";
+ ctxt.push();
+ for(;;){
+ {
+ for (;;) {
+ s: string;
+ if (len seps == 1)
+ s = stdin.gets(seps[0]);
+ else
+ s = stdin.gett(seps);
+ if (s == nil)
+ break;
+ # make sure we don't lose the last unterminated line
+ lastc := s[len s - 1];
+ if (lastc == seps[0])
+ s = s[0:len s - 1];
+ else for (i := 1; i < len seps; i++) {
+ if (lastc == seps[i]) {
+ s = s[0:len s - 1];
+ break;
+ }
+ }
+ ctxt.setlocal("line", ref Listnode(nil, s) :: nil);
+ status = setstatus(ctxt, ctxt.run(cmd, 0));
+ }
+ ctxt.pop();
+ return status;
+ } exception e {
+ "fail:*" =>
+ ctxt.pop();
+ if (loopexcept(e) == BREAK)
+ return status;
+ ctxt.push();
+ }
+ }
+}
+
+# usage: raise [name]
+builtin_raise(ctxt: ref Context, args: list of ref Listnode, nil: int) : string
+{
+ ename: ref Listnode;
+ if (tl args == nil) {
+ e := ctxt.get("exception");
+ if (e == nil)
+ ctxt.fail("bad raise context", "raise: no exception found");
+ ename = (hd e);
+ } else
+ ename = hd tl args;
+ if (ename.word == nil && ename.cmd != nil)
+ ctxt.fail("bad raise context", "raise: bad exception name");
+ xraise("fail:" + ename.word);
+ return nil;
+}
+
+# usage: rescue pattern rescuecmd cmd
+builtin_rescue(ctxt: ref Context, args: list of ref Listnode, last: int) : string
+{
+ args = tl args;
+ if (len args != 3 || !iscmd(hd tl args) || !iscmd(hd tl tl args))
+ builtinusage(ctxt, "rescue pattern {rescuecmd} {cmd}");
+ if ((hd args).word == nil && (hd args).cmd != nil)
+ ctxt.fail("usage", "rescue: bad pattern");
+ dolstar := ctxt.get("*");
+ handler := hd tl args :: dolstar;
+ code := hd tl tl args :: dolstar;
+ {
+ return ctxt.run(code, 0);
+ } exception e {
+ "fail:*" =>
+ ctxt.push();
+ ctxt.set("exception", ref Listnode(nil, e[5:]) :: nil);
+ {
+ status := ctxt.run(handler, last);
+ ctxt.pop();
+ return status;
+ } exception e2{
+ "fail:*" =>
+ ctxt.pop();
+ raise e;
+ }
+ }
+}
+
+builtin_not(ctxt: ref Context, args: list of ref Listnode, last: int): string
+{
+ # syntax: ! cmd [args...]
+ args = tl args;
+ if (args == nil || ctxt.run(args, last) == nil)
+ return "false";
+ return "";
+}
+
+builtin_for(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ Usage: con "for var in [item...] {cmd}";
+ args = tl args;
+ if (args == nil)
+ builtinusage(ctxt, Usage);
+ var := (hd args).word;
+ if (var == nil)
+ ctxt.fail("bad assign", "for: bad variable name");
+ args = tl args;
+ if (args == nil || (hd args).word != "in")
+ builtinusage(ctxt, Usage);
+ args = tl args;
+ if (args == nil)
+ builtinusage(ctxt, Usage);
+ for (eargs := args; tl eargs != nil; eargs = tl eargs)
+ ;
+ cmd := hd eargs;
+ if (!iscmd(cmd))
+ builtinusage(ctxt, Usage);
+
+ status := "";
+ dolstar := ctxt.get("*");
+ for(;;){
+ {
+ for (; tl args != nil; args = tl args) {
+ ctxt.setlocal(var, hd args :: nil);
+ status = setstatus(ctxt, ctxt.run(cmd :: dolstar, 0));
+ }
+ return status;
+ } exception e {
+ "fail:*" =>
+ if (loopexcept(e) == BREAK)
+ return status;
+ args = tl args;
+ }
+ }
+}
+
+CONTINUE, BREAK: con iota;
+loopexcept(ename: string): int
+{
+ case ename[5:] {
+ "break" =>
+ return BREAK;
+ "continue" =>
+ return CONTINUE;
+ * =>
+ raise ename;
+ }
+ return 0;
+}
+
+builtin_apply(ctxt: ref Context, args: list of ref Listnode, nil: int): string
+{
+ args = tl args;
+ if (args == nil || !iscmd(hd args))
+ builtinusage(ctxt, "apply {cmd} [val...]");
+
+ status := "";
+ cmd := hd args;
+ for(;;){
+ {
+ for (args = tl args; args != nil; args = tl args)
+ status = setstatus(ctxt, ctxt.run(cmd :: hd args :: nil, 0));
+
+ return status;
+ } exception e{
+ "fail:*" =>
+ if (loopexcept(e) == BREAK)
+ return status;
+ }
+ }
+}
+
+builtin_status(nil: ref Context, args: list of ref Listnode, nil: int): string
+{
+ if (tl args != nil)
+ return (hd tl args).word;
+ return "";
+}
+
+pctlnames := array[] of {
+ ("newfd", Sys->NEWFD),
+ ("forkfd", Sys->FORKFD),
+ ("newns", Sys->NEWNS),
+ ("forkns", Sys->FORKNS),
+ ("newpgrp", Sys->NEWPGRP),
+ ("nodevs", Sys->NODEVS)
+};
+
+builtin_pctl(ctxt: ref Context, argv: list of ref Listnode, nil: int): string
+{
+ if (len argv < 2)
+ builtinusage(ctxt, "pctl option... [fdnum...]");
+
+ finalmask := 0;
+ fdlist: list of int;
+ for (argv = tl argv; argv != nil; argv = tl argv) {
+ w := (hd argv).word;
+ if (isnum(w))
+ fdlist = int w :: fdlist;
+ else {
+ for (i := 0; i < len pctlnames; i++) {
+ (name, mask) := pctlnames[i];
+ if (name == w) {
+ finalmask |= mask;
+ break;
+ }
+ }
+ if (i == len pctlnames)
+ ctxt.fail("usage", "pctl: unknown flag " + w);
+ }
+ }
+ sys->pctl(finalmask, fdlist);
+ return nil;
+}
+
+# usage: ~ value pattern...
+builtin_twiddle(ctxt: ref Context, argv: list of ref Listnode, nil: int): string
+{
+ argv = tl argv;
+ if (argv == nil)
+ builtinusage(ctxt, "~ word [pattern...]");
+ if (tl argv == nil)
+ return "no match";
+ w := word(hd argv);
+
+ for (argv = tl argv; argv != nil; argv = tl argv)
+ if (filepat->match(word(hd argv), w))
+ return "";
+
+ return "no match";
+}
+
+#builtin_echo(ctxt: ref Context, argv: list of ref Listnode, nil: int): string
+#{
+# argv = tl argv;
+# nflag := 0;
+# if (argv != nil && word(hd argv) == "-n") {
+# nflag = 1;
+# argv = tl argv;
+# }
+# s: string;
+# if (argv != nil) {
+# s = word(hd argv);
+# for (argv = tl argv; argv != nil; argv = tl argv)
+# s += " " + word(hd argv);
+# }
+# e: int;
+# if (nflag)
+# e = sys->print("%s", s);
+# else
+# e = sys->print("%s\n", s);
+# if (e == -1) {
+# err := sys->sprint("%r");
+# if (ctxt.options() & ctxt.VERBOSE)
+# sys->fprint(sys->fildes(2), "echo: write error: %s\n", err);
+# return err;
+# }
+# return nil;
+#}
+
+ENOEXIST: con "file does not exist";
+TMPDIR: con "/tmp/pipes";
+sbuiltin_pipe(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ n: int;
+ if (len argv != 3 || !iscmd(hd tl tl argv))
+ builtinusage(ctxt, "pipe (from|to|fdnum) {cmd}");
+ s := (hd tl argv).word;
+ case s {
+ "from" =>
+ n = 1;
+ "to" =>
+ n = 0;
+ * =>
+ if (!isnum(s))
+ builtinusage(ctxt, "pipe (from|to|fdnum) {cmd}");
+ n = int s;
+ }
+ pipeid := ctxt.get("pipeid");
+ seq: int;
+ if (pipeid == nil)
+ seq = 0;
+ else
+ seq = int (hd pipeid).word;
+ id := "pipe." + string sys->pctl(0, nil) + "." + string seq;
+ ctxt.set("pipeid", ref Listnode(nil, string ++seq) :: nil);
+ mkdir(TMPDIR);
+ d := "/tmp/" + id + "d";
+ if (mkdir(d) == -1)
+ ctxt.fail("bad pipe", sys->sprint("pipe: cannot make %s: %r", d));
+ if (sys->bind("#|", d, Sys->MREPL) == -1) {
+ sys->remove(d);
+ ctxt.fail("bad pipe", sys->sprint("pipe: cannot bind pipe onto %s: %r", d));
+ }
+ if (rename(d + "/data", id + "x") == -1 || rename(d + "/data1", id + "y")) {
+ sys->unmount(nil, d);
+ sys->remove(d);
+ ctxt.fail("bad pipe", sys->sprint("pipe: cannot rename pipe: %r"));
+ }
+ if (sys->bind(d, TMPDIR, Sys->MBEFORE) == -1) {
+ sys->unmount(nil, d);
+ sys->remove(d);
+ ctxt.fail("bad pipe", sys->sprint("pipe: cannot bind pipe dir: %r"));
+ }
+ sys->unmount(nil, d);
+ sys->remove(d);
+ sync := chan of string;
+ spawn runpipe(sync, ctxt, n, TMPDIR + "/" + id + "x", hd tl tl argv);
+ if ((e := <-sync) != nil)
+ ctxt.fail("bad pipe", e);
+ return ref Listnode(nil, TMPDIR + "/" + id + "y") :: nil;
+}
+
+mkdir(f: string): int
+{
+ if (sys->create(f, Sys->OREAD, Sys->DMDIR | 8r777) == nil)
+ return -1;
+ return 0;
+}
+
+runpipe(sync: chan of string, ctxt: ref Context, fdno: int, p: string, cmd: ref Listnode)
+{
+ sys->pctl(Sys->FORKFD, nil);
+ ctxt = ctxt.copy(1);
+ if ((fd := sys->open(p, Sys->ORDWR)) == nil) {
+ sync <-= sys->sprint("cannot open %s: %r", p);
+ exit;
+ }
+ sys->dup(fd.fd, fdno);
+ fd = nil;
+ sync <-= nil;
+ ctxt.run(cmd :: ctxt.get("*"), 1);
+}
+
+rename(x, y: string): int
+{
+ (ok, nil) := sys->stat(x);
+ if (ok == -1)
+ return -1;
+ inf := sys->nulldir;
+ inf.name = y;
+ if (sys->wstat(x, inf) == -1)
+ return -1;
+ return 0;
+}
+
+builtinusage(ctxt: ref Context, s: string)
+{
+ ctxt.fail("usage", "usage: " + s);
+}
+
+setstatus(ctxt: ref Context, val: string): string
+{
+ ctxt.setlocal("status", ref Listnode(nil, val) :: nil);
+ return val;
+}
+
+# same as sys->raise(), but check that length of error string is
+# acceptable, and truncate as appropriate.
+xraise(s: string)
+{
+ d := array of byte s;
+ if (len d > Sys->WAITLEN)
+ raise string d[0:Sys->WAITLEN];
+ else {
+ d = nil;
+ raise s;
+ }
+}
+
+isnum(s: string): int
+{
+ for (i := 0; i < len s; i++)
+ if (s[i] > '9' || s[i] < '0')
+ return 0;
+ return 1;
+}
+
diff --git a/appl/cmd/sh/string.b b/appl/cmd/sh/string.b
new file mode 100644
index 00000000..b6d079e4
--- /dev/null
+++ b/appl/cmd/sh/string.b
@@ -0,0 +1,212 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+include "string.m";
+ str: String;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("string: cannot load self: %r"));
+ str = load String String->PATH;
+ if (str == nil)
+ ctxt.fail("bad module",
+ sys->sprint("string: cannot load %s: %r", String->PATH));
+ ctxt.addbuiltin("prefix", myself);
+ ctxt.addbuiltin("in", myself);
+ names := array[] of {
+ "splitl", "splitr", "drop", "take", "splitstrl", "splitstrr",
+ "tolower", "toupper", "len", "alen", "slice", "fields",
+ "padl", "padr",
+ };
+ for (i := 0; i < len names; i++)
+ ctxt.addsbuiltin(names[i], myself);
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(ctxt: ref Context, nil: Sh,
+ argv: list of ref Listnode, nil: int): string
+{
+ case (hd argv).word {
+ "prefix" =>
+ (a, b) := earg2("prefix", ctxt, argv);
+ if (!str->prefix(a, b))
+ return "false";
+ "in" =>
+ (a, b) := earg2("in", ctxt, argv);
+ if (a == nil || !str->in(a[0], b))
+ return "false";
+ }
+ return nil;
+}
+
+runsbuiltin(ctxt: ref Context, nil: Sh,
+ argv: list of ref Listnode): list of ref Listnode
+{
+ name := (hd argv).word;
+ case name {
+ "splitl" =>
+ (a, b) := earg2("splitl", ctxt, argv);
+ return mk2(str->splitl(a, b));
+ "splitr" =>
+ (a, b) := earg2("splitr", ctxt, argv);
+ return mk2(str->splitr(a, b));
+ "drop" =>
+ (a, b) := earg2("drop", ctxt, argv);
+ return mk1(str->drop(a, b));
+ "take" =>
+ (a, b) := earg2("take", ctxt, argv);
+ return mk1(str->take(a, b));
+ "splitstrl" =>
+ (a, b) := earg2("splitstrl", ctxt, argv);
+ return mk2(str->splitstrl(a, b));
+ "splitstrr" =>
+ (a, b) := earg2("splitstrr", ctxt, argv);
+ return mk2(str->splitstrr(a, b));
+ "tolower" =>
+ return mk1(str->tolower(earg1("tolower", ctxt, argv)));
+ "toupper" =>
+ return mk1(str->toupper(earg1("tolower", ctxt, argv)));
+ "len" =>
+ return mk1(string len earg1("len", ctxt, argv));
+ "alen" =>
+ return mk1(string len array of byte earg1("alen", ctxt, argv));
+ "slice" =>
+ return sbuiltin_slice(ctxt, argv);
+ "fields" =>
+ return sbuiltin_fields(ctxt, argv);
+ "padl" =>
+ return sbuiltin_pad(ctxt, argv, -1);
+ "padr" =>
+ return sbuiltin_pad(ctxt, argv, 1);
+ }
+ return nil;
+}
+
+sbuiltin_pad(ctxt: ref Context, argv: list of ref Listnode, dir: int): list of ref Listnode
+{
+ if (tl argv == nil || !isnum((hd tl argv).word))
+ ctxt.fail("usage", "usage: " + (hd argv).word + " n [arg...]");
+
+ argv = tl argv;
+ n := int (hd argv).word * dir;
+ s := "";
+ for (argv = tl argv; argv != nil; argv = tl argv) {
+ s += word(hd argv);
+ if (tl argv != nil)
+ s[len s] = ' ';
+ }
+ if (n != 0)
+ s = sys->sprint("%*s", n, s);
+ return ref Listnode(nil, s) :: nil;
+}
+
+sbuiltin_fields(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ argv = tl argv;
+ if (len argv != 2)
+ ctxt.fail("usage", "usage: fields cl s");
+ cl := word(hd argv);
+ s := word(hd tl argv);
+
+ r: list of string;
+
+ n := 0;
+ for (i := 0; i < len s; i++) {
+ if (str->in(s[i], cl)) {
+ r = s[n:i] :: r;
+ n = i + 1;
+ }
+ }
+ r = s[n:i] :: r;
+ rl: list of ref Listnode;
+ for (; r != nil; r = tl r)
+ rl = ref Listnode(nil, hd r) :: rl;
+ return rl;
+}
+
+
+sbuiltin_slice(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ argv = tl argv;
+ if (len argv != 3 || !isnum((hd argv).word) ||
+ (hd tl argv).word != "end" && !isnum((hd tl argv).word))
+ ctxt.fail("usage", "usage: slice start end arg");
+ n1 := int (hd argv).word;
+ n2: int;
+ s := word(hd tl tl argv);
+ r := "";
+ if ((hd tl argv).word == "end")
+ n2 = len s;
+ else
+ n2 = int (hd tl argv).word;
+ if (n2 > len s)
+ n2 = len s;
+ if (n1 > len s)
+ n1 = len s;
+ if (n2 > n1)
+ r = s[n1:n2];
+ return mk1(r);
+}
+
+earg2(cmd: string, ctxt: ref Context, argv: list of ref Listnode): (string, string)
+{
+ argv = tl argv;
+ if (len argv != 2)
+ ctxt.fail("usage", "usage: " + cmd + " arg1 arg2");
+ return (word(hd argv), word(hd tl argv));
+}
+
+earg1(cmd: string, ctxt: ref Context, argv: list of ref Listnode): string
+{
+ if (len argv != 2)
+ ctxt.fail("usage", "usage: " + cmd + " arg");
+ return word(hd tl argv);
+}
+
+mk2(x: (string, string)): list of ref Listnode
+{
+ (a, b) := x;
+ return ref Listnode(nil, a) :: ref Listnode(nil, b) :: nil;
+}
+
+mk1(x: string): list of ref Listnode
+{
+ return ref Listnode(nil, x) :: nil;
+}
+
+isnum(s: string): int
+{
+ for (i := 0; i < len s; i++)
+ if (s[i] > '9' || s[i] < '0')
+ return 0;
+ return 1;
+}
+
+word(n: ref Listnode): string
+{
+ if (n.word != nil)
+ return n.word;
+ if (n.cmd != nil)
+ n.word = sh->cmd2string(n.cmd);
+ return n.word;
+}
diff --git a/appl/cmd/sh/test.b b/appl/cmd/sh/test.b
new file mode 100644
index 00000000..d8a6b62a
--- /dev/null
+++ b/appl/cmd/sh/test.b
@@ -0,0 +1,96 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+include "itslib.m";
+ itslib: Itslib;
+ Tconfig, S_INFO, S_WARN, S_ERROR, S_FATAL: import itslib;
+
+tconf: ref Tconfig;
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ itslib = load Itslib Itslib->PATH;
+ if (itslib != nil)
+ tconf = itslib->init();
+ sh = shmod;
+ myself = load Shellbuiltin "$self";
+ if (myself == nil)
+ ctxt.fail("bad module", sys->sprint("its: cannot load self: %r"));
+ ctxt.addbuiltin("report", myself);
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+
+
+runbuiltin(ctxt: ref Sh->Context, nil: Sh,
+ cmd: list of ref Sh->Listnode, nil: int): string
+{
+ case (hd cmd).word {
+ "report" =>
+ if (len cmd < 4)
+ rusage(ctxt);
+ cmd = tl cmd;
+ sevstr := (hd cmd).word;
+ sev := sevtran(sevstr);
+ if (sev < 0)
+ rusage(ctxt);
+ cmd = tl cmd;
+ verb := (hd cmd).word;
+ cmd = tl cmd;
+ mtext := "";
+ i := 0;
+ while (len cmd) {
+ msg := (hd cmd).word;
+ cmd = tl cmd;
+ if (i++ > 0)
+ mtext = mtext + " ";
+ mtext = mtext + msg;
+ }
+ if (tconf != nil)
+ tconf.report(int sev, int verb, mtext);
+ else
+ sys->fprint(sys->fildes(2), "[itslib missing] %s %s\n", sevstr, mtext);
+ }
+ return nil;
+}
+
+
+runsbuiltin(nil: ref Sh->Context, nil: Sh,
+ nil: list of ref Sh->Listnode): list of ref Listnode
+{
+ return nil;
+}
+
+
+sevtran(sname: string): int
+{
+ SEVMAP := array[] of {"INF", "WRN", "ERR", "FTL"};
+ for (i:=0; i<len SEVMAP; i++)
+ if (sname == SEVMAP[i])
+ return i;
+ return -1;
+}
+
+rusage(ctxt: ref Context)
+{
+ ctxt.fail("usage", "usage: report INF|WRN|ERR|FTL verbosity message[...]");
+}
+
diff --git a/appl/cmd/sh/tk.b b/appl/cmd/sh/tk.b
new file mode 100644
index 00000000..bc6fe753
--- /dev/null
+++ b/appl/cmd/sh/tk.b
@@ -0,0 +1,426 @@
+implement Shellbuiltin;
+
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "tk.m";
+ tk: Tk;
+include "tkclient.m";
+ tkclient: Tkclient;
+include "sh.m";
+ sh: Sh;
+ Listnode, Context: import sh;
+ myself: Shellbuiltin;
+
+tklock: chan of int;
+
+chans := array[23] of list of (string, chan of string);
+wins := array[16] of list of (int, ref Tk->Toplevel);
+winid := 0;
+
+badmodule(ctxt: ref Context, p: string)
+{
+ ctxt.fail("bad module", sys->sprint("tk: cannot load %s: %r", p));
+}
+
+initbuiltin(ctxt: ref Context, shmod: Sh): string
+{
+ sys = load Sys Sys->PATH;
+ sh = shmod;
+
+ myself = load Shellbuiltin "$self";
+ if (myself == nil) badmodule(ctxt, "self");
+
+ tk = load Tk Tk->PATH;
+ if (tk == nil) badmodule(ctxt, Tk->PATH);
+
+ tkclient = load Tkclient Tkclient->PATH;
+ if (tkclient == nil) badmodule(ctxt, Tkclient->PATH);
+ tkclient->init();
+
+ tklock = chan[1] of int;
+
+ ctxt.addbuiltin("tk", myself);
+ ctxt.addbuiltin("chan", myself);
+ ctxt.addbuiltin("send", myself);
+
+ ctxt.addsbuiltin("tk", myself);
+ ctxt.addsbuiltin("recv", myself);
+ ctxt.addsbuiltin("alt", myself);
+ ctxt.addsbuiltin("tkquote", myself);
+ return nil;
+}
+
+whatis(nil: ref Sh->Context, nil: Sh, nil: string, nil: int): string
+{
+ return nil;
+}
+
+getself(): Shellbuiltin
+{
+ return myself;
+}
+
+runbuiltin(ctxt: ref Context, nil: Sh,
+ cmd: list of ref Listnode, nil: int): string
+{
+ case (hd cmd).word {
+ "tk" => return builtin_tk(ctxt, cmd);
+ "chan" => return builtin_chan(ctxt, cmd);
+ "send" => return builtin_send(ctxt, cmd);
+ }
+ return nil;
+}
+
+runsbuiltin(ctxt: ref Context, nil: Sh,
+ cmd: list of ref Listnode): list of ref Listnode
+{
+ case (hd cmd).word {
+ "tk" => return sbuiltin_tk(ctxt, cmd);
+ "recv" => return sbuiltin_recv(ctxt, cmd);
+ "alt" => return sbuiltin_alt(ctxt, cmd);
+ "tkquote" => return sbuiltin_tkquote(ctxt, cmd);
+ }
+ return nil;
+}
+
+builtin_tk(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ # usage: tk window _title_ _options_
+ # tk wintitle _winid_ _title_
+ # tk _winid_ _cmd_
+ if (tl argv == nil)
+ ctxt.fail("usage", "usage: tk (<winid>|window|onscreen|winctlwintitle|del|namechan) args...");
+ argv = tl argv;
+ w := (hd argv).word;
+ case w {
+ "window" =>
+ remark(ctxt, string makewin(ctxt, tl argv));
+ "wintitle" =>
+ argv = tl argv;
+ # change the title of a window
+ if (len argv != 2 || !isnum((hd argv).word))
+ ctxt.fail("usage", "usage: tk wintitle winid title");
+ tkclient->settitle(egetwin(ctxt, hd argv), word(hd tl argv));
+ "winctl" =>
+ argv = tl argv;
+ if (len argv != 2 || !isnum((hd argv).word))
+ ctxt.fail("usage", "usage: tk winctl winid cmd");
+ wid := (hd argv).word;
+ win := egetwin(ctxt, hd argv);
+ rq := word(hd tl argv);
+ if (rq == "exit") {
+ delwin(int wid);
+ delchan(wid);
+ }
+ tkclient->wmctl(win, rq);
+ "onscreen" =>
+ argv = tl argv;
+ if (len argv < 1 || !isnum((hd argv).word))
+ ctxt.fail("usage", "usage: tk onscreen winid [how]");
+ wid := (hd argv).word;
+ how := "";
+ if(tl argv != nil)
+ how = word(hd tl argv);
+ win := egetwin(ctxt, hd argv);
+ tkclient->startinput(win, "ptr" :: "kbd" :: nil);
+ tkclient->onscreen(win, how);
+ "namechan" =>
+ argv = tl argv;
+ n := len argv;
+ if (n < 2 || n > 3 || !isnum((hd argv).word))
+ ctxt.fail("usage", "usage: tk namechan winid chan [name]");
+ name: string;
+ if (n == 3)
+ name = word(hd tl tl argv);
+ else
+ name = word(hd tl argv);
+ tk->namechan(egetwin(ctxt, hd argv), egetchan(ctxt, hd tl argv), name);
+
+ "del" =>
+ if (len argv < 2)
+ ctxt.fail("usage", "usage: tk del id...");
+ for (argv = tl argv; argv != nil; argv = tl argv) {
+ id := (hd argv).word;
+ if (isnum(id))
+ delwin(int id);
+ delchan(id);
+ }
+ * =>
+ e := tkcmd(ctxt, argv);
+ if (e != nil)
+ remark(ctxt, e);
+ if (e != nil && e[0] == '!')
+ return e;
+ }
+ return nil;
+}
+
+remark(ctxt: ref Context, s: string)
+{
+ if (ctxt.options() & ctxt.INTERACTIVE)
+ sys->print("%s\n", s);
+}
+
+# create a new window (and its associated channel)
+makewin(ctxt: ref Context, argv: list of ref Listnode): int
+{
+ if (argv == nil)
+ ctxt.fail("usage", "usage: tk window title options");
+
+ if (ctxt.drawcontext == nil)
+ ctxt.fail("no draw context", sys->sprint("tk: no graphics context available"));
+
+ (title, options) := (word(hd argv), concat(tl argv));
+ (top, topchan) := tkclient->toplevel(ctxt.drawcontext, options, title, Tkclient->Appl);
+ newid := addwin(top);
+ addchan(string newid, topchan);
+ return newid;
+}
+
+builtin_chan(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ # create a new channel
+ argv = tl argv;
+ if (argv == nil)
+ ctxt.fail("usage", "usage: chan name....");
+ for (; argv != nil; argv = tl argv) {
+ name := (hd argv).word;
+ if (name == nil || isnum(name))
+ ctxt.fail("bad chan", "tk: bad channel name "+q(name));
+ if (addchan(name, chan of string) == nil)
+ ctxt.fail("bad chan", "tk: channel "+q(name)+" already exists");
+ }
+ return nil;
+}
+
+builtin_send(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ if (len argv != 3)
+ ctxt.fail("usage", "usage: send chan arg");
+ argv = tl argv;
+ c := egetchan(ctxt, hd argv);
+ c <-= word(hd tl argv);
+ return nil;
+}
+
+
+sbuiltin_tk(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ # usage: tk _winid_ _command_
+ # tk window _title_ _options_
+ argv = tl argv;
+ if (argv == nil)
+ ctxt.fail("usage", "tk (window|wid) args");
+ case (hd argv).word {
+ "window" =>
+ return ref Listnode(nil, string makewin(ctxt, tl argv)) :: nil;
+ "winids" =>
+ ret: list of ref Listnode;
+ for (i := 0; i < len wins; i++)
+ for (wl := wins[i]; wl != nil; wl = tl wl)
+ ret = ref Listnode(nil, string (hd wl).t0) :: ret;
+ return ret;
+ * =>
+ return ref Listnode(nil, tkcmd(ctxt, argv)) :: nil;
+ }
+}
+
+sbuiltin_alt(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ # usage: alt chan ...
+ argv = tl argv;
+ if (argv == nil)
+ ctxt.fail("usage", "usage: alt chan...");
+ ca := array[len argv] of chan of string;
+ cname := array[len ca] of string;
+ i := 0;
+ for (; argv != nil; argv = tl argv) {
+ ca[i] = egetchan(ctxt, hd argv);
+ cname[i] = (hd argv).word;
+ i++;
+ }
+ n := 0;
+ v: string;
+ if (i == 1)
+ v = <-ca[0];
+ else
+ (n, v) = <-ca;
+
+ return ref Listnode(nil, cname[n]) :: ref Listnode(nil, v) :: nil;
+}
+
+sbuiltin_recv(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ # usage: recv chan
+ if (len argv != 2)
+ ctxt.fail("usage", "usage: recv chan");
+ ch := hd tl argv;
+ c := egetchan(ctxt, ch);
+ if(!isnum(ch.word))
+ return ref Listnode(nil, <-c) :: nil;
+
+ win := egetwin(ctxt, ch);
+ for(;;)alt{
+ key := <-win.ctxt.kbd =>
+ tk->keyboard(win, key);
+ p := <-win.ctxt.ptr =>
+ tk->pointer(win, *p);
+ s := <-win.ctxt.ctl or
+ s = <-win.wreq or
+ s = <-c =>
+ return ref Listnode(nil, s) :: nil;
+ }
+}
+
+sbuiltin_tkquote(ctxt: ref Context, argv: list of ref Listnode): list of ref Listnode
+{
+ if (len argv != 2)
+ ctxt.fail("usage", "usage: tkquote arg");
+ return ref Listnode(nil, tk->quote(word(hd tl argv))) :: nil;
+}
+
+tkcmd(ctxt: ref Context, argv: list of ref Listnode): string
+{
+ if (argv == nil || !isnum((hd argv).word))
+ ctxt.fail("usage", "usage: tk winid command");
+
+ return tk->cmd(egetwin(ctxt, hd argv), concat(tl argv));
+}
+
+hashfn(s: string, n: int): int
+{
+ h := 0;
+ m := len s;
+ for(i:=0; i<m; i++){
+ h = 65599*h+s[i];
+ }
+ return (h & 16r7fffffff) % n;
+}
+
+q(s: string): string
+{
+ return "'" + s + "'";
+}
+
+egetchan(ctxt: ref Context, n: ref Listnode): chan of string
+{
+ if ((c := getchan(n.word)) == nil)
+ ctxt.fail("bad chan", "tk: bad channel name "+ q(n.word));
+ return c;
+}
+
+# assumes that n.word has been checked and found to be numeric.
+egetwin(ctxt: ref Context, n: ref Listnode): ref Tk->Toplevel
+{
+ wid := int n.word;
+ if (wid < 0 || (top := getwin(wid)) == nil)
+ ctxt.fail("bad win", "tk: unknown window id " + q(n.word));
+ return top;
+}
+
+getchan(name: string): chan of string
+{
+ n := hashfn(name, len chans);
+ for (cl := chans[n]; cl != nil; cl = tl cl) {
+ (cname, c) := hd cl;
+ if (cname == name)
+ return c;
+ }
+ return nil;
+}
+
+addchan(name: string, c: chan of string): chan of string
+{
+ n := hashfn(name, len chans);
+ tklock <-= 1;
+ if (getchan(name) == nil)
+ chans[n] = (name, c) :: chans[n];
+ <-tklock;
+ return c;
+}
+
+delchan(name: string)
+{
+ n := hashfn(name, len chans);
+ tklock <-= 1;
+ ncl: list of (string, chan of string);
+ for (cl := chans[n]; cl != nil; cl = tl cl) {
+ (cname, nil) := hd cl;
+ if (cname != name)
+ ncl = hd cl :: ncl;
+ }
+ chans[n] = ncl;
+ <-tklock;
+}
+
+addwin(top: ref Tk->Toplevel): int
+{
+ tklock <-= 1;
+ id := winid++;
+ slot := id % len wins;
+ wins[slot] = (id, top) :: wins[slot];
+ <-tklock;
+ return id;
+}
+
+delwin(id: int)
+{
+ tklock <-= 1;
+ slot := id % len wins;
+ nwl: list of (int, ref Tk->Toplevel);
+ for (wl := wins[slot]; wl != nil; wl = tl wl) {
+ (wid, nil) := hd wl;
+ if (wid != id)
+ nwl = hd wl :: nwl;
+ }
+ wins[slot] = nwl;
+ <-tklock;
+}
+
+getwin(id: int): ref Tk->Toplevel
+{
+ slot := id % len wins;
+ for (wl := wins[slot]; wl != nil; wl = tl wl) {
+ (wid, top) := hd wl;
+ if (wid == id)
+ return top;
+ }
+ return nil;
+}
+
+word(n: ref Listnode): string
+{
+ if (n.word != nil)
+ return n.word;
+ if (n.cmd != nil)
+ n.word = sh->cmd2string(n.cmd);
+ return n.word;
+}
+
+isnum(s: string): int
+{
+ for (i := 0; i < len s; i++)
+ if (s[i] > '9' || s[i] < '0')
+ return 0;
+ return 1;
+}
+
+concat(argv: list of ref Listnode): string
+{
+ if (argv == nil)
+ return nil;
+ s := word(hd argv);
+ for (argv = tl argv; argv != nil; argv = tl argv)
+ s += " " + word(hd argv);
+ return s;
+}
+
+lockproc(c: chan of int)
+{
+ sys->pctl(Sys->NEWFD|Sys->NEWNS, nil);
+ for(;;){
+ c <-= 1;
+ <-c;
+ }
+}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 21:04:55 +0000