ref: 82b046f36f8084a22bbb5d71edd0edd9179561eb
dir: /appl/cmd/fc.b/
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 + "'");
}