1implement Fc; 2include "sys.m"; 3 sys: Sys; 4include "draw.m"; 5include "math.m"; 6 math: Math; 7include "string.m"; 8 str: String; 9include "regex.m"; 10 regex: Regex; 11 12Fc: module { 13 init: fn(nil: ref Draw->Context, argv: list of string); 14}; 15 16 17UNARY, BINARY, SPECIAL: con iota; 18 19oSWAP, oDUP, oREP, oSUM, oPRNUM, oMULT, 20oPLUS, oMINUS, oDIV, oDIVIDE, oMOD, oSHIFTL, oSHIFTR, 21oAND, oOR, oXOR, oNOT, oUMINUS, oFACTORIAL, 22oPOW, oHYPOT, oATAN2, oJN, oYN, oSCALBN, oCOPYSIGN, 23oFDIM, oFMIN, oFMAX, oNEXTAFTER, oREMAINDER, oFMOD, 24oPOW10, oSQRT, oEXP, oEXPM1, oLOG, oLOG10, oLOG1P, 25oCOS, oCOSH, oSIN, oSINH, oTAN, oTANH, oACOS, oASIN, oACOSH, 26oASINH, oATAN, oATANH, oERF, oERFC, 27oJ0, oJ1, oY0, oY1, oILOGB, oFABS, oCEIL, 28oFLOOR, oFINITE, oISNAN, oRINT, oLGAMMA, oMODF, 29oDEG, oRAD: con iota; 30Op: adt { 31 name: string; 32 kind: int; 33 op: int; 34}; 35 36ops := array[] of { 37Op 38("swap", SPECIAL, oSWAP), 39("dup", SPECIAL, oDUP), 40("rep", SPECIAL, oREP), 41("sum", SPECIAL, oSUM), 42("p", SPECIAL, oPRNUM), 43("x", BINARY, oMULT), 44("×", BINARY, oMULT), 45("pow", BINARY, oPOW), 46("xx", BINARY, oPOW), 47("+", BINARY, oPLUS), 48("-", BINARY, oMINUS), 49("/", BINARY, oDIVIDE), 50("div", BINARY, oDIV), 51("%", BINARY, oMOD), 52("shl", BINARY, oSHIFTL), 53("shr", BINARY, oSHIFTR), 54("and", BINARY, oAND), 55("or", BINARY, oOR), 56("⋀", BINARY, oAND), 57("⋁", BINARY, oOR), 58("xor", BINARY, oXOR), 59("not", UNARY, oNOT), 60("_", UNARY, oUMINUS), 61("factorial", UNARY, oFACTORIAL), 62("!", UNARY, oFACTORIAL), 63("pow", BINARY, oPOW), 64("hypot", BINARY, oHYPOT), 65("atan2", BINARY, oATAN2), 66("jn", BINARY, oJN), 67("yn", BINARY, oYN), 68("scalbn", BINARY, oSCALBN), 69("copysign", BINARY, oCOPYSIGN), 70("fdim", BINARY, oFDIM), 71("fmin", BINARY, oFMIN), 72("fmax", BINARY, oFMAX), 73("nextafter", BINARY, oNEXTAFTER), 74("remainder", BINARY, oREMAINDER), 75("fmod", BINARY, oFMOD), 76("pow10", UNARY, oPOW10), 77("sqrt", UNARY, oSQRT), 78("exp", UNARY, oEXP), 79("expm1", UNARY, oEXPM1), 80("log", UNARY, oLOG), 81("log10", UNARY, oLOG10), 82("log1p", UNARY, oLOG1P), 83("cos", UNARY, oCOS), 84("cosh", UNARY, oCOSH), 85("sin", UNARY, oSIN), 86("sinh", UNARY, oSINH), 87("tan", UNARY, oTAN), 88("tanh", UNARY, oTANH), 89("acos", UNARY, oACOS), 90("asin", UNARY, oASIN), 91("acosh", UNARY, oACOSH), 92("asinh", UNARY, oASINH), 93("atan", UNARY, oATAN), 94("atanh", UNARY, oATANH), 95("erf", UNARY, oERF), 96("erfc", UNARY, oERFC), 97("j0", UNARY, oJ0), 98("j1", UNARY, oJ1), 99("y0", UNARY, oY0), 100("y1", UNARY, oY1), 101("ilogb", UNARY, oILOGB), 102("fabs", UNARY, oFABS), 103("ceil", UNARY, oCEIL), 104("floor", UNARY, oFLOOR), 105("finite", UNARY, oFINITE), 106("isnan", UNARY, oISNAN), 107("rint", UNARY, oRINT), 108("rad", UNARY, oRAD), 109("deg", UNARY, oDEG), 110("lgamma", SPECIAL, oLGAMMA), 111("modf", SPECIAL, oMODF), 112}; 113 114nHEX, nBINARY, nOCTAL, nRADIX1, nRADIX2, nREAL, nCHAR: con iota; 115pats0 := array[] of { 116nHEX => "-?0[xX][0-9a-fA-F]+", 117nBINARY => "-?0[bB][01]+", 118nOCTAL => "-?0[0-7]+", 119nRADIX1 => "-?[0-9][rR][0-8]+", 120nRADIX2 => "-?[0-3][0-9][rR][0-9a-zA-Z]+", 121nREAL => "-?(([0-9]+(\\.[0-9]+)?)|([0-9]*(\\.[0-9]+)))([eE]-?[0-9]+)?", 122nCHAR => "@.", 123}; 124RADIX, ANNOTATE, CHAR: con 1 << (iota + 10); 125 126outbase := 10; 127pats: array of Regex->Re; 128stack: list of real; 129last_op: Op; 130stderr: ref Sys->FD; 131 132usage() 133{ 134 sys->fprint(stderr, 135 "usage: fc [-xdbB] [-r radix] <postfix expression>\n" + 136 "option specifies output format:\n" + 137 "\t-d decimal (default)\n" + 138 "\t-x hex\n" + 139 "\t-o octal\n" + 140 "\t-b binary\n" + 141 "\t-B annotated binary\n" + 142 "\t-c character\n" + 143 "\t-r <radix> specified base in Limbo 99r9999 format\n" + 144 "operands are decimal(default), hex(0x), octal(0), binary(0b), radix(99r)\n"); 145 sys->fprint(stderr, "operators are:\n"); 146 for (i := 0; i < len ops; i++) 147 sys->fprint(stderr, "%s ", ops[i].name); 148 sys->fprint(stderr, "\n"); 149 raise "fail:usage"; 150} 151 152init(nil: ref Draw->Context, argv: list of string) 153{ 154 sys = load Sys Sys->PATH; 155 stderr = sys->fildes(2); 156 math = load Math Math->PATH; 157 regex = load Regex Regex->PATH; 158 if (regex == nil) { 159 sys->fprint(stderr, "fc: cannot load %s: %r\n", Regex->PATH); 160 raise "fail:error"; 161 } 162 163 initpats(); 164 165 if (argv == nil || tl argv == nil) 166 return; 167 argv = tl argv; 168 a := hd argv; 169 if (len a > 1 && a[0] == '-' && number(a).t0 == 0) { 170 case a[1] { 171 'd' => 172 outbase = 10; 173 'x' => 174 outbase = 16; 175 'o' => 176 outbase = 8; 177 'b' => 178 outbase = 2; 179 'c' => 180 outbase = CHAR; 181 'r' => 182 r := 0; 183 if (len a > 2) 184 r = int a[2:]; 185 else if (tl argv == nil) 186 usage(); 187 else { 188 argv = tl argv; 189 r = int hd argv; 190 } 191 if (r < 2 || r > 36) 192 usage(); 193 outbase = r | RADIX; 194 'B' => 195 outbase = 2 | ANNOTATE; 196 * => 197 sys->fprint(stderr, "fc: unknown option -%c\n", a[1]); 198 usage(); 199 } 200 argv = tl argv; 201 } 202 203 math->FPcontrol(0, Math->INVAL|Math->ZDIV|Math->OVFL|Math->UNFL|Math->INEX); 204 205 for (; argv != nil; argv = tl argv) { 206 (ok, x) := number(hd argv); 207 if (ok) 208 stack = x :: stack; 209 else { 210 op := find(hd argv); 211 exec(op); 212 last_op = op; 213 } 214 } 215 216 sp: list of real; 217 for (; stack != nil; stack = tl stack) 218 sp = hd stack :: sp; 219 220 # print stack bottom first 221 for (; sp != nil; sp = tl sp) 222 printnum(hd sp); 223} 224 225printnum(n: real) 226{ 227 case outbase { 228 CHAR => 229 sys->print("@%c\n", int n); 230 2 => 231 sys->print("%s\n", binary(big n)); 232 2 | ANNOTATE => 233 sys->print("%s\n", annotatebinary(big n)); 234 8 => 235 sys->print("%#bo\n", big n); 236 10 => 237 sys->print("%g\n", n); 238 16 => 239 sys->print("%#bx\n", big n); 240 * => 241 if ((outbase & RADIX) == 0) 242 error("unknown output base " + string outbase); 243 sys->print("%s\n", big2string(big n, outbase & ~RADIX)); 244 } 245} 246 247# convert to binary string, keeping multiples of 8 digits. 248binary(n: big): string 249{ 250 s := "0b"; 251 for (j := 7; j > 0; j--) 252 if ((n & (big 16rff << (j * 8))) != big 0) 253 break; 254 for (i := 63; i >= 0; i--) 255 if (i / 8 <= j) 256 s[len s] = (int (n >> i) & 1) + '0'; 257 return s; 258} 259 260annotatebinary(n: big): string 261{ 262 s := binary(n); 263 a := s + "\n "; 264 ndig := len s - 2; 265 for (i := ndig - 1; i >= 0; i--) 266 a[len a] = (i % 10) + '0'; 267 if (ndig < 10) 268 return a; 269 a += "\n "; 270 for (i = ndig - 1; i >= 10; i--) { 271 if (i % 10 == 0) 272 a[len a] = (i / 10) + '0'; 273 else 274 a[len a] = ' '; 275 } 276 return a; 277} 278 279find(name: string): Op 280{ 281 # XXX could do binary search here if we weren't a lousy performer anyway 282 for (i := 0; i < len ops; i++) 283 if (name == ops[i].name) 284 break; 285 if (i == len ops) 286 error("invalid operator '" + name + "'"); 287 return ops[i]; 288} 289 290exec(op: Op) 291{ 292 case op.kind { 293 UNARY => 294 unaryop(op.name, op.op); 295 BINARY => 296 binaryop(op.name, op.op); 297 SPECIAL => 298 specialop(op.name, op.op); 299 } 300} 301 302unaryop(name: string, op: int) 303{ 304 assure(1, name); 305 v := hd stack; 306 case op { 307 oNOT => 308 v = real !(int v); 309 oUMINUS => 310 v = -v; 311 oFACTORIAL => 312 n := int v; 313 v = 1.0; 314 while (n > 0) 315 v *= real n--; 316 oPOW10 => 317 v = math->pow10(int v); 318 oSQRT => 319 v = math->sqrt(v); 320 oEXP => 321 v = math->exp(v); 322 oEXPM1 => 323 v = math->expm1(v); 324 oLOG => 325 v = math->log(v); 326 oLOG10 => 327 v = math->log10(v); 328 oLOG1P => 329 v = math->log1p(v); 330 oCOS => 331 v = math->cos(v); 332 oCOSH => 333 v = math->cosh(v); 334 oSIN => 335 v = math->sin(v); 336 oSINH => 337 v = math->sinh(v); 338 oTAN => 339 v = math->tan(v); 340 oTANH => 341 v = math->tanh(v); 342 oACOS => 343 v = math->acos(v); 344 oASIN => 345 v = math->asin(v); 346 oACOSH => 347 v = math->acosh(v); 348 oASINH => 349 v = math->asinh(v); 350 oATAN => 351 v = math->atan(v); 352 oATANH => 353 v = math->atanh(v); 354 oERF => 355 v = math->erf(v); 356 oERFC => 357 v = math->erfc(v); 358 oJ0 => 359 v = math->j0(v); 360 oJ1 => 361 v = math->j1(v); 362 oY0 => 363 v = math->y0(v); 364 oY1 => 365 v = math->y1(v); 366 oILOGB => 367 v = real math->ilogb(v); 368 oFABS => 369 v = math->fabs(v); 370 oCEIL => 371 v = math->ceil(v); 372 oFLOOR => 373 v = math->floor(v); 374 oFINITE => 375 v = real math->finite(v); 376 oISNAN => 377 v = real math->isnan(v); 378 oRINT => 379 v = math->rint(v); 380 oRAD => 381 v = (v / 360.0) * 2.0 * Math->Pi; 382 oDEG => 383 v = v / (2.0 * Math->Pi) * 360.0; 384 * => 385 error("unknown unary operator '" + name + "'"); 386 } 387 stack = v :: tl stack; 388} 389 390binaryop(name: string, op: int) 391{ 392 assure(2, name); 393 v1 := hd stack; 394 v0 := hd tl stack; 395 case op { 396 oMULT => 397 v0 = v0 * v1; 398 oPLUS => 399 v0 = v0 + v1; 400 oMINUS => 401 v0 = v0 - v1; 402 oDIVIDE => 403 v0 = v0 / v1; 404 oDIV => 405 v0 = real (big v0 / big v1); 406 oMOD => 407 v0 = real (big v0 % big v1); 408 oSHIFTL => 409 v0 = real (big v0 << int v1); 410 oSHIFTR => 411 v0 = real (big v0 >> int v1); 412 oAND => 413 v0 = real (big v0 & big v1); 414 oOR => 415 v0 = real (big v0 | big v1); 416 oXOR => 417 v0 = real (big v0 ^ big v1); 418 oPOW => 419 v0 = math->pow(v0, v1); 420 oHYPOT => 421 v0 = math->hypot(v0, v1); 422 oATAN2 => 423 v0 = math->atan2(v0, v1); 424 oJN => 425 v0 = math->jn(int v0, v1); 426 oYN => 427 v0 = math->yn(int v0, v1); 428 oSCALBN => 429 v0 = math->scalbn(v0, int v1); 430 oCOPYSIGN => 431 v0 = math->copysign(v0, v1); 432 oFDIM => 433 v0 = math->fdim(v0, v1); 434 oFMIN => 435 v0 = math->fmin(v0, v1); 436 oFMAX => 437 v0 = math->fmax(v0, v1); 438 oNEXTAFTER => 439 v0 = math->nextafter(v0, v1); 440 oREMAINDER => 441 v0 = math->remainder(v0, v1); 442 oFMOD => 443 v0 = math->fmod(v0, v1); 444 * => 445 error("unknown binary operator '" + name + "'"); 446 } 447 stack = v0 :: tl tl stack; 448} 449 450specialop(name: string, op: int) 451{ 452 case op { 453 oSWAP => 454 assure(2, name); 455 stack = hd tl stack :: hd stack :: tl tl stack; 456 oDUP => 457 assure(1, name); 458 stack = hd stack :: stack; 459 oREP => 460 if (last_op.kind != BINARY) 461 error("invalid operator '" + last_op.name + "' for rep"); 462 while (stack != nil && tl stack != nil) 463 exec(last_op); 464 oSUM => 465 for (sum := 0.0; stack != nil; stack = tl stack) 466 sum += hd stack; 467 stack = sum :: nil; 468 oPRNUM => 469 assure(1, name); 470 printnum(hd stack); 471 stack = tl stack; 472 oLGAMMA => 473 assure(1, name); 474 (s, lg) := math->lgamma(hd stack); 475 stack = lg :: real s :: tl stack; 476 oMODF => 477 assure(1, name); 478 (i, r) := math->modf(hd stack); 479 stack = r :: real i :: tl stack; 480 * => 481 error("unknown operator '" + name + "'"); 482 } 483} 484 485initpats() 486{ 487 pats = array[len pats0] of Regex->Re; 488 for (i := 0; i < len pats0; i++) { 489 (re, e) := regex->compile("^" + pats0[i] + "$", 0); 490 if (re == nil) { 491 sys->fprint(stderr, "fc: bad number pattern '^%s$': %s\n", pats0[i], e); 492 raise "fail:error"; 493 } 494 pats[i] = re; 495 } 496} 497 498number(s: string): (int, real) 499{ 500 case s { 501 "pi" or 502 "π" => 503 return (1, Math->Pi); 504 "e" => 505 return (1, 2.71828182845904509); 506 "nan" or 507 "NaN" => 508 return (1, Math->NaN); 509 "-nan" or 510 "-NaN" => 511 return (1, -Math->NaN); 512 "infinity" or 513 "Infinity" or 514 "∞" => 515 return (1, Math->Infinity); 516 "-infinity" or 517 "-Infinity" or 518 "-∞" => 519 return (1, -Math->Infinity); 520 "eps" or 521 "macheps" => 522 return (1, Math->MachEps); 523 } 524 for (i := 0; i < len pats; i++) { 525 if (regex->execute(pats[i], s) != nil) 526 break; 527 } 528 case i { 529 nHEX => 530 return base(s, 2, 16); 531 nBINARY => 532 return base(s, 2, 2); 533 nOCTAL => 534 return base(s, 1, 8); 535 nRADIX1 => 536 return base(s, 2, int s); 537 nRADIX2 => 538 return base(s, 3, int s); 539 nREAL => 540 return (1, real s); 541 nCHAR => 542 return (1, real s[1]); 543 } 544 return (0, Math->NaN); 545} 546 547base(s: string, i: int, radix: int): (int, real) 548{ 549 neg := s[0] == '-'; 550 if (neg) 551 i++; 552 n := big 0; 553 if (radix == 10) 554 n = big s[i:]; 555 else if (radix == 0 || radix > 36) 556 return (0, Math->NaN); 557 else { 558 for (; i < len s; i++) { 559 c := s[i]; 560 if ('0' <= c && c <= '9') 561 n = (n * big radix) + big(c - '0'); 562 else if ('a' <= c && c < 'a' + radix - 10) 563 n = (n * big radix) + big(c - 'a' + 10); 564 else if ('A' <= c && c < 'A' + radix - 10) 565 n = (n * big radix) + big(c - 'A' + 10); 566 else 567 return (0, Math->NaN); 568 } 569 } 570 if (neg) 571 n = -n; 572 return (1, real n); 573} 574 575# stolen from /appl/cmd/sh/expr.b 576big2string(n: big, radix: int): string 577{ 578 if (neg := n < big 0) { 579 n = -n; 580 } 581 s := ""; 582 do { 583 c: int; 584 d := int (n % big radix); 585 if (d < 10) 586 c = '0' + d; 587 else 588 c = 'a' + d - 10; 589 s[len s] = c; 590 n /= big radix; 591 } while (n > big 0); 592 t := s; 593 for (i := len s - 1; i >= 0; i--) 594 t[len s - 1 - i] = s[i]; 595 if (radix != 10) 596 t = string radix + "r" + t; 597 if (neg) 598 return "-" + t; 599 return t; 600} 601 602error(e: string) 603{ 604 sys->fprint(stderr, "fc: %s\n", e); 605 raise "fail:error"; 606} 607 608assure(n: int, opname: string) 609{ 610 if (len stack < n) 611 error("stack too small for op '" + opname + "'"); 612} 613