summaryrefslogtreecommitdiff
path: root/appl/cmd/fc.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/cmd/fc.b')
-rw-r--r--appl/cmd/fc.b612
1 files changed, 612 insertions, 0 deletions
diff --git a/appl/cmd/fc.b b/appl/cmd/fc.b
new file mode 100644
index 00000000..50393b14
--- /dev/null
+++ b/appl/cmd/fc.b
@@ -0,0 +1,612 @@
+implement Fc;
+include "sys.m";
+ sys: Sys;
+include "draw.m";
+include "math.m";
+ math: Math;
+include "string.m";
+ str: String;
+include "regex.m";
+ regex: Regex;
+
+Fc: module {
+ init: fn(nil: ref Draw->Context, argv: list of string);
+};
+
+
+UNARY, BINARY, SPECIAL: con iota;
+
+oSWAP, oDUP, oREP, oSUM, oPRNUM, oMULT,
+oPLUS, oMINUS, oDIV, oDIVIDE, oMOD, oSHIFTL, oSHIFTR,
+oAND, oOR, oXOR, oNOT, oUMINUS, oFACTORIAL,
+oPOW, oHYPOT, oATAN2, oJN, oYN, oSCALBN, oCOPYSIGN,
+oFDIM, oFMIN, oFMAX, oNEXTAFTER, oREMAINDER, oFMOD,
+oPOW10, oSQRT, oEXP, oEXPM1, oLOG, oLOG10, oLOG1P,
+oCOS, oCOSH, oSIN, oSINH, oTAN, oTANH, oACOS, oASIN, oACOSH,
+oASINH, oATAN, oATANH, oERF, oERFC,
+oJ0, oJ1, oY0, oY1, oILOGB, oFABS, oCEIL,
+oFLOOR, oFINITE, oISNAN, oRINT, oLGAMMA, oMODF,
+oDEG, oRAD: con iota;
+Op: adt {
+ name: string;
+ kind: int;
+ op: int;
+};
+
+ops := array[] of {
+Op
+("swap", SPECIAL, oSWAP),
+("dup", SPECIAL, oDUP),
+("rep", SPECIAL, oREP),
+("sum", SPECIAL, oSUM),
+("p", SPECIAL, oPRNUM),
+("x", BINARY, oMULT),
+("×", BINARY, oMULT),
+("pow", BINARY, oPOW),
+("xx", BINARY, oPOW),
+("+", BINARY, oPLUS),
+("-", BINARY, oMINUS),
+("/", BINARY, oDIVIDE),
+("div", BINARY, oDIV),
+("%", BINARY, oMOD),
+("shl", BINARY, oSHIFTL),
+("shr", BINARY, oSHIFTR),
+("and", BINARY, oAND),
+("or", BINARY, oOR),
+("⋀", BINARY, oAND),
+("⋁", BINARY, oOR),
+("xor", BINARY, oXOR),
+("not", UNARY, oNOT),
+("_", UNARY, oUMINUS),
+("factorial", UNARY, oFACTORIAL),
+("!", UNARY, oFACTORIAL),
+("pow", BINARY, oPOW),
+("hypot", BINARY, oHYPOT),
+("atan2", BINARY, oATAN2),
+("jn", BINARY, oJN),
+("yn", BINARY, oYN),
+("scalbn", BINARY, oSCALBN),
+("copysign", BINARY, oCOPYSIGN),
+("fdim", BINARY, oFDIM),
+("fmin", BINARY, oFMIN),
+("fmax", BINARY, oFMAX),
+("nextafter", BINARY, oNEXTAFTER),
+("remainder", BINARY, oREMAINDER),
+("fmod", BINARY, oFMOD),
+("pow10", UNARY, oPOW10),
+("sqrt", UNARY, oSQRT),
+("exp", UNARY, oEXP),
+("expm1", UNARY, oEXPM1),
+("log", UNARY, oLOG),
+("log10", UNARY, oLOG10),
+("log1p", UNARY, oLOG1P),
+("cos", UNARY, oCOS),
+("cosh", UNARY, oCOSH),
+("sin", UNARY, oSIN),
+("sinh", UNARY, oSINH),
+("tan", UNARY, oTAN),
+("tanh", UNARY, oTANH),
+("acos", UNARY, oACOS),
+("asin", UNARY, oASIN),
+("acosh", UNARY, oACOSH),
+("asinh", UNARY, oASINH),
+("atan", UNARY, oATAN),
+("atanh", UNARY, oATANH),
+("erf", UNARY, oERF),
+("erfc", UNARY, oERFC),
+("j0", UNARY, oJ0),
+("j1", UNARY, oJ1),
+("y0", UNARY, oY0),
+("y1", UNARY, oY1),
+("ilogb", UNARY, oILOGB),
+("fabs", UNARY, oFABS),
+("ceil", UNARY, oCEIL),
+("floor", UNARY, oFLOOR),
+("finite", UNARY, oFINITE),
+("isnan", UNARY, oISNAN),
+("rint", UNARY, oRINT),
+("rad", UNARY, oRAD),
+("deg", UNARY, oDEG),
+("lgamma", SPECIAL, oLGAMMA),
+("modf", SPECIAL, oMODF),
+};
+
+nHEX, nBINARY, nOCTAL, nRADIX1, nRADIX2, nREAL, nCHAR: con iota;
+pats0 := array[] of {
+nHEX => "-?0[xX][0-9a-fA-F]+",
+nBINARY => "-?0[bB][01]+",
+nOCTAL => "-?0[0-7]+",
+nRADIX1 => "-?[0-9][rR][0-8]+",
+nRADIX2 => "-?[0-3][0-9][rR][0-9a-zA-Z]+",
+nREAL => "-?(([0-9]+(\\.[0-9]+)?)|([0-9]*(\\.[0-9]+)))([eE]-?[0-9]+)?",
+nCHAR => "@.",
+};
+RADIX, ANNOTATE, CHAR: con 1 << (iota + 10);
+
+outbase := 10;
+pats: array of Regex->Re;
+stack: list of real;
+last_op: Op;
+stderr: ref Sys->FD;
+
+usage()
+{
+ sys->fprint(stderr,
+ "usage: fc [-xdbB] [-r radix] <postfix expression>\n" +
+ "option specifies output format:\n" +
+ "\t-d decimal (default)\n" +
+ "\t-x hex\n" +
+ "\t-o octal\n" +
+ "\t-b binary\n" +
+ "\t-B annotated binary\n" +
+ "\t-c character\n" +
+ "\t-r <radix> specified base in Limbo 99r9999 format\n" +
+ "operands are decimal(default), hex(0x), octal(0), binary(0b), radix(99r)\n");
+ sys->fprint(stderr, "operators are:\n");
+ for (i := 0; i < len ops; i++)
+ sys->fprint(stderr, "%s ", ops[i].name);
+ sys->fprint(stderr, "\n");
+ raise "fail:usage";
+}
+
+init(nil: ref Draw->Context, argv: list of string)
+{
+ sys = load Sys Sys->PATH;
+ stderr = sys->fildes(2);
+ math = load Math Math->PATH;
+ regex = load Regex Regex->PATH;
+ if (regex == nil) {
+ sys->fprint(stderr, "fc: cannot load %s: %r\n", Regex->PATH);
+ raise "fail:error";
+ }
+
+ initpats();
+
+ if (argv == nil || tl argv == nil)
+ return;
+ argv = tl argv;
+ a := hd argv;
+ if (len a > 1 && a[0] == '-' && number(a).t0 == 0) {
+ case a[1] {
+ 'd' =>
+ outbase = 10;
+ 'x' =>
+ outbase = 16;
+ 'o' =>
+ outbase = 8;
+ 'b' =>
+ outbase = 2;
+ 'c' =>
+ outbase = CHAR;
+ 'r' =>
+ r := 0;
+ if (len a > 2)
+ r = int a[2:];
+ else if (tl argv == nil)
+ usage();
+ else {
+ argv = tl argv;
+ r = int hd argv;
+ }
+ if (r < 2 || r > 36)
+ usage();
+ outbase = r | RADIX;
+ 'B' =>
+ outbase = 2 | ANNOTATE;
+ * =>
+ sys->fprint(stderr, "fc: unknown option -%c\n", a[1]);
+ usage();
+ }
+ argv = tl argv;
+ }
+
+ math->FPcontrol(0, Math->INVAL|Math->ZDIV|Math->OVFL|Math->UNFL|Math->INEX);
+
+ for (; argv != nil; argv = tl argv) {
+ (ok, x) := number(hd argv);
+ if (ok)
+ stack = x :: stack;
+ else {
+ op := find(hd argv);
+ exec(op);
+ last_op = op;
+ }
+ }
+
+ sp: list of real;
+ for (; stack != nil; stack = tl stack)
+ sp = hd stack :: sp;
+
+ # print stack bottom first
+ for (; sp != nil; sp = tl sp)
+ printnum(hd sp);
+}
+
+printnum(n: real)
+{
+ case outbase {
+ CHAR =>
+ sys->print("@%c\n", int n);
+ 2 =>
+ sys->print("%s\n", binary(big n));
+ 2 | ANNOTATE =>
+ sys->print("%s\n", annotatebinary(big n));
+ 8 =>
+ sys->print("%#bo\n", big n);
+ 10 =>
+ sys->print("%g\n", n);
+ 16 =>
+ sys->print("%#bx\n", big n);
+ * =>
+ if ((outbase & RADIX) == 0)
+ error("unknown output base " + string outbase);
+ sys->print("%s\n", big2string(big n, outbase & ~RADIX));
+ }
+}
+
+# convert to binary string, keeping multiples of 8 digits.
+binary(n: big): string
+{
+ s := "0b";
+ for (j := 7; j > 0; j--)
+ if ((n & (big 16rff << (j * 8))) != big 0)
+ break;
+ for (i := 63; i >= 0; i--)
+ if (i / 8 <= j)
+ s[len s] = (int (n >> i) & 1) + '0';
+ return s;
+}
+
+annotatebinary(n: big): string
+{
+ s := binary(n);
+ a := s + "\n ";
+ ndig := len s - 2;
+ for (i := ndig - 1; i >= 0; i--)
+ a[len a] = (i % 10) + '0';
+ if (ndig < 10)
+ return a;
+ a += "\n ";
+ for (i = ndig - 1; i >= 10; i--) {
+ if (i % 10 == 0)
+ a[len a] = (i / 10) + '0';
+ else
+ a[len a] = ' ';
+ }
+ return a;
+}
+
+find(name: string): Op
+{
+ # XXX could do binary search here if we weren't a lousy performer anyway
+ for (i := 0; i < len ops; i++)
+ if (name == ops[i].name)
+ break;
+ if (i == len ops)
+ error("invalid operator '" + name + "'");
+ return ops[i];
+}
+
+exec(op: Op)
+{
+ case op.kind {
+ UNARY =>
+ unaryop(op.name, op.op);
+ BINARY =>
+ binaryop(op.name, op.op);
+ SPECIAL =>
+ specialop(op.name, op.op);
+ }
+}
+
+unaryop(name: string, op: int)
+{
+ assure(1, name);
+ v := hd stack;
+ case op {
+ oNOT =>
+ v = real !(int v);
+ oUMINUS =>
+ v = -v;
+ oFACTORIAL =>
+ n := int v;
+ v = 1.0;
+ while (n > 0)
+ v *= real n--;
+ oPOW10 =>
+ v = math->pow10(int v);
+ oSQRT =>
+ v = math->sqrt(v);
+ oEXP =>
+ v = math->exp(v);
+ oEXPM1 =>
+ v = math->expm1(v);
+ oLOG =>
+ v = math->log(v);
+ oLOG10 =>
+ v = math->log10(v);
+ oLOG1P =>
+ v = math->log1p(v);
+ oCOS =>
+ v = math->cos(v);
+ oCOSH =>
+ v = math->cosh(v);
+ oSIN =>
+ v = math->sin(v);
+ oSINH =>
+ v = math->sinh(v);
+ oTAN =>
+ v = math->tan(v);
+ oTANH =>
+ v = math->tanh(v);
+ oACOS =>
+ v = math->acos(v);
+ oASIN =>
+ v = math->asin(v);
+ oACOSH =>
+ v = math->acosh(v);
+ oASINH =>
+ v = math->asinh(v);
+ oATAN =>
+ v = math->atan(v);
+ oATANH =>
+ v = math->atanh(v);
+ oERF =>
+ v = math->erf(v);
+ oERFC =>
+ v = math->erfc(v);
+ oJ0 =>
+ v = math->j0(v);
+ oJ1 =>
+ v = math->j1(v);
+ oY0 =>
+ v = math->y0(v);
+ oY1 =>
+ v = math->y1(v);
+ oILOGB =>
+ v = real math->ilogb(v);
+ oFABS =>
+ v = math->fabs(v);
+ oCEIL =>
+ v = math->ceil(v);
+ oFLOOR =>
+ v = math->floor(v);
+ oFINITE =>
+ v = real math->finite(v);
+ oISNAN =>
+ v = real math->isnan(v);
+ oRINT =>
+ v = math->rint(v);
+ oRAD =>
+ v = (v / 360.0) * 2.0 * Math->Pi;
+ oDEG =>
+ v = v / (2.0 * Math->Pi) * 360.0;
+ * =>
+ error("unknown unary operator '" + name + "'");
+ }
+ stack = v :: tl stack;
+}
+
+binaryop(name: string, op: int)
+{
+ assure(2, name);
+ v1 := hd stack;
+ v0 := hd tl stack;
+ case op {
+ oMULT =>
+ v0 = v0 * v1;
+ oPLUS =>
+ v0 = v0 + v1;
+ oMINUS =>
+ v0 = v0 - v1;
+ oDIVIDE =>
+ v0 = v0 / v1;
+ oDIV =>
+ v0 = real (big v0 / big v1);
+ oMOD =>
+ v0 = real (big v0 % big v1);
+ oSHIFTL =>
+ v0 = real (big v0 << int v1);
+ oSHIFTR =>
+ v0 = real (big v0 >> int v1);
+ oAND =>
+ v0 = real (big v0 & big v1);
+ oOR =>
+ v0 = real (big v0 | big v1);
+ oXOR =>
+ v0 = real (big v0 ^ big v1);
+ oPOW =>
+ v0 = math->pow(v0, v1);
+ oHYPOT =>
+ v0 = math->hypot(v0, v1);
+ oATAN2 =>
+ v0 = math->atan2(v0, v1);
+ oJN =>
+ v0 = math->jn(int v0, v1);
+ oYN =>
+ v0 = math->yn(int v0, v1);
+ oSCALBN =>
+ v0 = math->scalbn(v0, int v1);
+ oCOPYSIGN =>
+ v0 = math->copysign(v0, v1);
+ oFDIM =>
+ v0 = math->fdim(v0, v1);
+ oFMIN =>
+ v0 = math->fmin(v0, v1);
+ oFMAX =>
+ v0 = math->fmax(v0, v1);
+ oNEXTAFTER =>
+ v0 = math->nextafter(v0, v1);
+ oREMAINDER =>
+ v0 = math->remainder(v0, v1);
+ oFMOD =>
+ v0 = math->fmod(v0, v1);
+ * =>
+ error("unknown binary operator '" + name + "'");
+ }
+ stack = v0 :: tl tl stack;
+}
+
+specialop(name: string, op: int)
+{
+ case op {
+ oSWAP =>
+ assure(2, name);
+ stack = hd tl stack :: hd stack :: tl tl stack;
+ oDUP =>
+ assure(1, name);
+ stack = hd stack :: stack;
+ oREP =>
+ if (last_op.kind != BINARY)
+ error("invalid operator '" + last_op.name + "' for rep");
+ while (stack != nil && tl stack != nil)
+ exec(last_op);
+ oSUM =>
+ for (sum := 0.0; stack != nil; stack = tl stack)
+ sum += hd stack;
+ stack = sum :: nil;
+ oPRNUM =>
+ assure(1, name);
+ printnum(hd stack);
+ stack = tl stack;
+ oLGAMMA =>
+ assure(1, name);
+ (s, lg) := math->lgamma(hd stack);
+ stack = lg :: real s :: tl stack;
+ oMODF =>
+ assure(1, name);
+ (i, r) := math->modf(hd stack);
+ stack = r :: real i :: tl stack;
+ * =>
+ error("unknown operator '" + name + "'");
+ }
+}
+
+initpats()
+{
+ pats = array[len pats0] of Regex->Re;
+ for (i := 0; i < len pats0; i++) {
+ (re, e) := regex->compile("^" + pats0[i] + "$", 0);
+ if (re == nil) {
+ sys->fprint(stderr, "fc: bad number pattern '^%s$': %s\n", pats0[i], e);
+ raise "fail:error";
+ }
+ pats[i] = re;
+ }
+}
+
+number(s: string): (int, real)
+{
+ case s {
+ "pi" or
+ "π" =>
+ return (1, Math->Pi);
+ "e" =>
+ return (1, 2.71828182845904509);
+ "nan" or
+ "NaN" =>
+ return (1, Math->NaN);
+ "-nan" or
+ "-NaN" =>
+ return (1, -Math->NaN);
+ "infinity" or
+ "Infinity" or
+ "∞" =>
+ return (1, Math->Infinity);
+ "-infinity" or
+ "-Infinity" or
+ "-∞" =>
+ return (1, -Math->Infinity);
+ "eps" or
+ "macheps" =>
+ return (1, Math->MachEps);
+ }
+ for (i := 0; i < len pats; i++) {
+ if (regex->execute(pats[i], s) != nil)
+ break;
+ }
+ case i {
+ nHEX =>
+ return base(s, 2, 16);
+ nBINARY =>
+ return base(s, 2, 2);
+ nOCTAL =>
+ return base(s, 1, 8);
+ nRADIX1 =>
+ return base(s, 2, int s);
+ nRADIX2 =>
+ return base(s, 3, int s);
+ nREAL =>
+ return (1, real s);
+ nCHAR =>
+ return (1, real s[1]);
+ }
+ return (0, Math->NaN);
+}
+
+base(s: string, i: int, radix: int): (int, real)
+{
+ neg := s[0] == '-';
+ if (neg)
+ i++;
+ n := big 0;
+ if (radix == 10)
+ n = big s[i:];
+ else if (radix == 0 || radix > 36)
+ return (0, Math->NaN);
+ else {
+ for (; i < len s; i++) {
+ c := s[i];
+ if ('0' <= c && c <= '9')
+ n = (n * big radix) + big(c - '0');
+ else if ('a' <= c && c < 'a' + radix - 10)
+ n = (n * big radix) + big(c - 'a' + 10);
+ else if ('A' <= c && c < 'A' + radix - 10)
+ n = (n * big radix) + big(c - 'A' + 10);
+ else
+ return (0, Math->NaN);
+ }
+ }
+ if (neg)
+ n = -n;
+ return (1, real n);
+}
+
+# stolen from /appl/cmd/sh/expr.b
+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;
+}
+
+error(e: string)
+{
+ sys->fprint(stderr, "fc: %s\n", e);
+ raise "fail:error";
+}
+
+assure(n: int, opname: string)
+{
+ if (len stack < n)
+ error("stack too small for op '" + opname + "'");
+}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 22:49:20 +0000