1implement M4; 2 3include "sys.m"; 4 sys: Sys; 5 6include "draw.m"; 7 8include "bufio.m"; 9 bufio: Bufio; 10 Iobuf: import bufio; 11 12include "sh.m"; 13 14include "arg.m"; 15 16M4: module 17{ 18 init: fn(nil: ref Draw->Context, nil: list of string); 19}; 20 21NHASH: con 131; 22 23Name: adt { 24 name: string; 25 repl: string; 26 impl: ref fn(nil: array of string); 27 dol: int; # repl contains $[0-9] 28 asis: int; # replacement text not rescanned 29 30 text: fn(n: self ref Name): string; 31}; 32 33names := array[NHASH] of list of ref Name; 34 35File: adt { 36 name: string; 37 line: int; 38 fp: ref Iobuf; 39}; 40 41Param: adt { 42 s: string; 43}; 44 45pushedback: string; 46pushedp := 0; # next available index in pushedback 47diverted := array[10] of string; 48curdiv := 0; 49curarg: ref Param; # non-nil if collecting argument string 50instack: list of ref File; 51lquote := '`'; 52rquote := '\''; 53initcom := "#"; 54endcom := "\n"; 55prefix := ""; 56bout: ref Iobuf; 57sh: Sh; 58stderr: ref Sys->FD; 59tracing := 0; 60 61init(nil: ref Draw->Context, args: list of string) 62{ 63 sys = load Sys Sys->PATH; 64 bufio = load Bufio Bufio->PATH; 65 66 bout = bufio->fopen(sys->fildes(1), Sys->OWRITE); 67 stderr = sys->fildes(2); 68 69 define("inferno", "inferno", 0); 70 71 arg := load Arg Arg->PATH; 72 arg->setusage("m4 [-t] [-pprefix] [-Dname[=value]] [-Qname[=value]] [-Uname] [file ...]"); 73 arg->init(args); 74 75 while((o := arg->opt()) != 0){ 76 case o { 77 'D' or 'Q' or 'U' => 78 ; # for second pass 79 'p' => 80 prefix = arg->earg(); 81 't' => 82 tracing = 1; 83 * => 84 arg->usage(); 85 } 86 } 87 88 builtin("changecom", dochangecom); 89 builtin("changequote", dochangequote); 90 builtin("copydef", docopydef); 91 builtin("define", dodefine); 92 builtin("divert", dodivert); 93 builtin("divnum", dodivnum); 94 builtin("dnl", dodnl); 95 builtin("dumpdef", dodumpdef); 96 builtin("errprint", doerrprint); 97 builtin("eval", doeval); 98 builtin("ifdef", doifdef); 99 builtin("ifelse", doifelse); 100 builtin("include", doinclude); 101 builtin("incr", doincr); 102 builtin("index", doindex); 103 builtin("len", dolen); 104 builtin("maketemp", domaketemp); 105 builtin("sinclude", dosinclude); 106 builtin("substr", dosubstr); 107 builtin("syscmd", dosyscmd); 108 builtin("translit", dotranslit); 109 builtin("undefine", doundefine); 110 builtin("undivert", doundivert); 111 112 arg->init(args); 113 114 while((o = arg->opt()) != 0){ 115 case o { 116 'D' => 117 argdefine(arg->earg(), 0); 118 'Q' => 119 argdefine(arg->earg(), 1); 120 'U' => 121 undefine(arg->earg()); 122 'p' => 123 arg->earg(); 124 't' => 125 ; 126 * => 127 arg->usage(); 128 } 129 } 130 args = arg->argv(); 131 arg = nil; 132 133 if(args != nil){ 134 for(; args != nil; args = tl args){ 135 f := bufio->open(hd args, Sys->OREAD); 136 if(f == nil) 137 error(sys->sprint("can't open %s: %r", hd args)); 138 pushfile(hd args, f); 139 scan(); 140 } 141 }else{ 142 pushfile("standard input", bufio->fopen(sys->fildes(0), Sys->OREAD)); 143 scan(); 144 } 145 bout.flush(); 146} 147 148argdefine(s: string, asis: int) 149{ 150 text := ""; 151 for(i := 0; i < len s; i++) 152 if(s[i] == '='){ 153 text = s[i+1:]; 154 break; 155 } 156 n := lookup(s[0: i]); 157 if(n != nil && n.impl != nil) 158 error(sys->sprint("can't redefine built-in %s", s[0: i])); 159 define(s[0: i], text, asis); 160} 161 162scan() 163{ 164 while((c := getc()) >= 0){ 165 if(isalpha(c)) 166 called(c); 167 else if(c == lquote) 168 quoted(); 169 else if(initcom != nil && initcom[0] == c) 170 comment(); 171 else 172 putc(c); 173 } 174} 175 176error(s: string) 177{ 178 where := ""; 179 if(instack != nil){ 180 ios := hd instack; 181 where = sys->sprint(" %s:%d:", ios.name, ios.line); 182 } 183 bout.flush(); 184 sys->fprint(stderr, "m4:%s %s\n", where, s); 185 raise "fail:error"; 186} 187 188pushfile(name: string, fp: ref Iobuf) 189{ 190 instack = ref File(name, 1, fp) :: instack; 191} 192 193called(c: int) 194{ 195 tok: string; 196 do{ 197 tok[len tok] = c; 198 c = getc(); 199 }while(isalpha(c) || c >= '0' && c <= '9'); 200 def := lookup(tok); 201 if(def == nil){ 202 pushc(c); 203 puts(tok); 204 return; 205 } 206 if(c != '(' || def.asis){ # no parameters 207 pushc(c); 208 expand(def, array[] of {tok}); 209 return; 210 } 211 # collect arguments, allowing for nested parentheses; 212 # on ')' expand definition, further expanding $n references therein 213 argstack := def.name :: nil; # $0 214 savearg := curarg; # save parameter (if any) for outer call 215 curarg = ref Param(""); 216 nesting := 0; # () depth 217 skipws(); 218 mark := instack; 219 for(;;){ 220 if((c = getc()) < 0) { 221 instack = mark; 222 error("EOF in parameters"); 223 } 224 if(isalpha(c)) 225 called(c); 226 else if(c == lquote) 227 quoted(); 228 else{ 229 if(c == '(') 230 nesting++; 231 if(nesting > 0){ 232 if(c == ')') 233 nesting--; 234 putc(c); 235 }else if(c == ','){ 236 argstack = curarg.s :: argstack; 237 curarg = ref Param(""); 238 skipws(); 239 }else if(c == ')') 240 break; 241 else 242 putc(c); 243 } 244 } 245 argstack = curarg.s :: argstack; 246 curarg = savearg; # restore outer parameter (if any) 247 # build arguments 248 narg := len argstack; 249 args := array[narg] of string; 250 for(; argstack != nil; argstack = tl argstack) 251 args[--narg] = hd argstack; 252 expand(def, args); 253} 254 255quoted() 256{ 257 nesting :=0; 258 mark := instack; 259 while((c := getc()) != rquote || nesting > 0){ 260 if(c < 0) { 261 instack = mark; 262 error("EOF in string"); 263 } 264 if(c == rquote) 265 nesting--; 266 else if(c == lquote) 267 nesting++; 268 putc(c); 269 } 270} 271 272comment() 273{ 274 for(i := 1; i < len initcom; i++){ 275 if((c := getc()) != initcom[i]){ 276 if(c < 0) 277 error("EOF in comment"); 278 pushc(c); 279 pushs(initcom[1: i]); 280 putc(initcom[0]); 281 return; 282 } 283 } 284 puts(initcom); 285 for(i = 0; i < len endcom;){ 286 c := getc(); 287 if(c < 0) 288 error("EOF in comment"); 289 putc(c); 290 if(c == endcom[i]) 291 i++; 292 else 293 i = c == endcom[0]; 294 } 295} 296 297skipws() 298{ 299 while(isspace(c := getc())) 300 {} 301 pushc(c); 302} 303 304isspace(c: int): int 305{ 306 return c == ' ' || c == '\t' || c == '\n' || c == '\r'; 307} 308 309isalpha(c: int): int 310{ 311 return c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z' || c == '_' || c > 16rA0 && c != lquote && c != rquote; 312} 313 314hash(name: string): int 315{ 316 h := 0; 317 for(i := 0; i < len name; i++) 318 h = h*65599 + name[i]; 319 return (h & ~(1<<31)) % NHASH; 320} 321 322builtin(name: string, impl: ref fn(nil: array of string)) 323{ 324 if(prefix != "") 325 name = prefix+name; 326 ibuiltin(name, impl); 327} 328 329ibuiltin(name: string, impl: ref fn(nil: array of string)) 330{ 331 h := hash(name); 332 n := ref Name(name, nil, impl, 0, 0); 333 names[h] = n :: names[h]; 334} 335 336define(name: string, repl: string, asis: int) 337{ 338 h := hash(name); 339 dol := hasdol(repl); 340 for(l := names[h]; l != nil; l = tl l){ 341 n := hd l; 342 if(n.name == name){ 343 *n = Name(name, repl, nil, dol, asis); 344 return; 345 } 346 } 347 n := ref Name(name, repl, nil, dol, asis); 348 names[h] = n :: names[h]; 349} 350 351lookup(name: string): ref Name 352{ 353 h := hash(name); 354 for(l := names[h]; l != nil; l = tl l) 355 if((hd l).name == name) 356 return hd l; 357 return nil; 358} 359 360undefine(name: string) 361{ 362 h := hash(name); 363 rl: list of ref Name; 364 for(l := names[h]; l != nil; l = tl l){ 365 if((hd l).name == name){ 366 l = tl l; 367 for(; rl != nil; rl = tl rl) 368 l = hd rl :: l; 369 names[h] = l; 370 return; 371 }else 372 rl = hd l :: rl; 373 } 374} 375 376Name.text(n: self ref Name): string 377{ 378 if(n.impl != nil) 379 return sys->sprint("builtin %q", n.name); 380 return sys->sprint("%c%s%c", lquote, n.repl, rquote); 381} 382 383dodumpdef(args: array of string) 384{ 385 if(len args > 1){ 386 for(i := 1; i < len args; i++) 387 if((n := lookup(args[i])) != nil) 388 sys->fprint(sys->fildes(2), "%q %s\n", n.name, n.text()); 389 }else{ 390 for(i := 0; i < len names; i++) 391 for(l := names[i]; l != nil; l = tl l) 392 sys->fprint(sys->fildes(2), "%q %s\n", (hd l).name, (hd l).text()); 393 } 394} 395 396pushs(s: string) 397{ 398 for(i := len s; --i >= 0;) 399 pushedback[pushedp++] = s[i]; 400} 401 402pushc(c: int) 403{ 404 if(c >= 0) 405 pushedback[pushedp++] = c; 406} 407 408getc(): int 409{ 410 if(pushedp > 0) 411 return pushedback[--pushedp]; 412 for(; instack != nil; instack = tl instack){ 413 ios := hd instack; 414 c := ios.fp.getc(); 415 if(c >= 0){ 416 if(c == '\n') 417 ios.line++; 418 return c; 419 } 420 } 421 return -1; 422} 423 424puts(s: string) 425{ 426 if(curarg != nil) 427 curarg.s += s; 428 else if(curdiv > 0) 429 diverted[curdiv] += s; 430 else if(curdiv == 0) 431 bout.puts(s); 432} 433 434putc(c: int) 435{ 436 if(curarg != nil){ 437 # stow in argument collection buffer 438 curarg.s[len curarg.s] = c; 439 }else if(curdiv > 0){ 440 l := len diverted[curdiv]; 441 diverted[curdiv][l] = c; 442 }else if(curdiv == 0) 443 bout.putc(c); 444} 445 446expand(def: ref Name, args: array of string) 447{ 448 if(tracing){ 449 sys->fprint(stderr, "expand %s [%s]", args[0], def.name); 450 for(i := 1; i < len args; i++) 451 sys->fprint(stderr, " %d: [%s]", i, args[i]); 452 sys->fprint(stderr, "\n"); 453 } 454 if(def.impl != nil){ 455 def.impl(args); 456 return; 457 } 458 if(def.repl == def.name || def.repl == "$0"){ 459 puts(def.name); 460 return; 461 } 462 if(!def.dol || def.repl == nil){ 463 pushs(def.repl); 464 return; 465 } 466 # expand $n 467 s := def.repl; 468 for(i := len s; --i >= 1;){ 469 if(s[i-1] == '$' && (c := s[i]-'0') >= 0 && c <= 9){ 470 if(c < len args) 471 pushs(args[c]); 472 i--; 473 }else 474 pushc(s[i]); 475 } 476 if(i >= 0) 477 pushc(s[0]); 478} 479 480hasdol(s: string): int 481{ 482 for(i := 0; i < len s; i++) 483 if(s[i] == '$') 484 return 1; 485 return 0; 486} 487 488dodefine(args: array of string) 489{ 490 if(len args > 2) 491 define(args[1], args[2], 0); 492 else if(len args > 1) 493 define(args[1], "", 0); 494} 495 496doundefine(args: array of string) 497{ 498 for(i := 1; i < len args; i++) 499 undefine(args[i]); 500} 501 502docopydef(args: array of string) 503{ 504 if(len args > 2 && args[1] != args[2]){ 505 undefine(args[2]); 506 if((n := lookup(args[1])) != nil){ 507 if(n.impl == nil) 508 define(args[2], n.repl, n.asis); 509 else 510 ibuiltin(args[2], n.impl); 511 }else 512 define(args[2], "", 0); 513 } 514} 515 516doeval(args: array of string) 517{ 518 if(len args > 1) 519 pushs(string eval(args[1])); 520} 521 522dodivert(args: array of string) 523{ 524 if(len args > 1){ 525 n := int args[1]; 526 if(n < 0 || n >= len diverted) 527 n = -1; 528 curdiv = n; 529 }else 530 curdiv = 0; 531} 532 533dodivnum(nil: array of string) 534{ 535 pushs(string curdiv); 536} 537 538doundivert(args: array of string) 539{ 540 if(len args <= 1){ # do all but current, in order 541 for(i := 1; i < len diverted; i++){ 542 if(i != curdiv){ 543 puts(diverted[i]); 544 diverted[i] = nil; 545 } 546 } 547 }else{ # do those specified 548 for(i := 1; i < len args; i++){ 549 n := int args[i]; 550 if(n > 0 && n < len diverted && n != curdiv){ 551 puts(diverted[n]); 552 diverted[n] = nil; 553 } 554 } 555 } 556} 557 558doifdef(args: array of string) 559{ 560 if(len args < 3) 561 return; 562 n := lookup(args[1]); 563 if(n != nil) 564 pushs(args[2]); 565 else if(len args > 3) 566 pushs(args[3]); 567} 568 569doifelse(args: array of string) 570{ 571 for(i := 1; i+2 < len args; i += 3){ 572 if(args[i] == args[i+1]){ 573 pushs(args[i+2]); 574 return; 575 } 576 } 577 if(i > 2 && i == len args-1) 578 pushs(args[i]); 579} 580 581doincr(args: array of string) 582{ 583 if(len args > 1) 584 pushs(string (int args[1] + 1)); 585} 586 587doindex(args: array of string) 588{ 589 if(len args > 2){ 590 a := args[1]; 591 b := args[2]; 592 for(i := 0; i+len b <= len a; i++){ 593 if(a[i: i+len b] == b){ 594 pushs(string i); 595 return; 596 } 597 } 598 pushs("-1"); 599 } 600} 601 602doinclude(args: array of string) 603{ 604 for(i := len args; --i >= 1;){ 605 fp := bufio->open(args[i], Sys->OREAD); 606 if(fp == nil) 607 error(sys->sprint("can't open %s: %r", args[i])); 608 pushfile(args[i], fp); 609 } 610} 611 612dosinclude(args: array of string) 613{ 614 for(i := len args; --i >= 1;){ 615 fp := bufio->open(args[i], Sys->OREAD); 616 if(fp != nil) 617 pushfile(args[i], fp); 618 } 619} 620 621clip(v, l, u: int): int 622{ 623 if(v < l) 624 return l; 625 if(v > u) 626 return u; 627 return v; 628} 629 630dosubstr(args: array of string) 631{ 632 if(len args > 2){ 633 l := len args[1]; 634 o := clip(int args[2], 0, l); 635 n := l; 636 if(len args > 3) 637 n = clip(int args[3], 0, l); 638 if((n += o) > l) 639 n = l; 640 pushs(args[1][o: n]); 641 } 642} 643 644cindex(s: string, c: int): int 645{ 646 for(i := 0; i < len s; i++) 647 if(s[i] == c) 648 return i; 649 return -1; 650} 651 652dotranslit(args: array of string) 653{ 654 if(len args < 3) 655 return; 656 s := args[1]; 657 f := args[2]; 658 t := ""; 659 if(len args > 3) 660 t = args[3]; 661 o := ""; 662 for(i := 0; i < len s; i++){ 663 if((j := cindex(f, s[i])) >= 0){ 664 if(j < len t) 665 o[len o] = t[j]; 666 }else 667 o[len o] = s[i]; 668 } 669 pushs(o); 670} 671 672doerrprint(args: array of string) 673{ 674 s := ""; 675 for(i := 1; i < len args; i++) 676 s += " "+args[i]; 677 if(s != nil) 678 sys->fprint(stderr, "m4:%s\n", s); 679} 680 681dolen(args: array of string) 682{ 683 if(len args > 1) 684 puts(string len args[1]); 685} 686 687dochangecom(args: array of string) 688{ 689 case len args { 690 1 => 691 initcom = ""; 692 endcom = ""; 693 2 => 694 initcom = args[1]; 695 endcom = "\n"; 696 * => 697 initcom = args[1]; 698 endcom = args[2]; 699 if(endcom == "") 700 endcom = "\n"; 701 } 702} 703 704dochangequote(args: array of string) 705{ 706 case len args { 707 1 => 708 lquote = '`'; 709 rquote = '\''; 710 2 => 711 if(args[1] != nil) 712 lquote = rquote = args[1][0]; 713 * => 714 if(args[1] != nil) 715 lquote = args[1][0]; 716 if(args[2] != nil) 717 rquote = args[2][0]; 718 } 719} 720 721dodnl(nil: array of string) 722{ 723 while((c := getc()) >= 0 && c != '\n') 724 {} 725} 726 727domaketemp(args: array of string) 728{ 729 if(len args > 1) 730 pushs(mktemp(args[1])); 731} 732 733dosyscmd(args: array of string) 734{ 735 if(len args > 1){ 736 { 737 if(sh == nil){ 738 sh = load Sh Sh->PATH; 739 if(sh == nil) 740 raise sys->sprint("load: can't load %s: %r", Sh->PATH); 741 } 742 bout.flush(); 743 sh->system(nil, args[1]); 744 }exception e{ 745 "load:*" => 746 error(e); 747 } 748 } 749} 750 751sysname: string; 752 753mktemp(s: string): string 754{ 755 if(sysname == nil) 756 sysname = readfile("/dev/sysname", "m4"); 757 # trim trailing X's 758 for (x := len s; --x >= 0;) 759 if(s[x] == 'X'){ 760 while(x > 0 && s[x-1] == 'X') 761 x--; 762 s = s[0: x]; 763 break; 764 } 765 # add system name, process ID and 'a' 766 if(s != nil) 767 s += "."; 768 s += sys->sprint("%s.%.10uda", sysname, sys->pctl(0, nil)); 769 while(sys->stat(s).t0 >= 0){ 770 if(s[len s-1] == 'z') 771 error("out of temp files: "+s); 772 s[len s-1]++; 773 } 774 return s; 775} 776 777readfile(name: string, default: string): string 778{ 779 fd := sys->open(name, Sys->OREAD); 780 if(fd == nil) 781 return default; 782 buf := array[Sys->NAMEMAX] of byte; 783 n := sys->read(fd, buf, len buf); 784 if(n <= 0) 785 return default; 786 return string buf[0: n]; 787} 788 789# 790# expressions provided use Limbo operators (C with signed shift and **), 791# instead of original m4 ones (where | and & were || and &&, and ^ was power), 792# but that's true of later unix m4 implementations too 793# 794 795Oeof, Ogok, Oge, Ole, One, Oeq, Opow, Oand, Oor, Orsh, Olsh, Odigits: con 'a'+iota; 796Syntax, Badeval: exception; 797evalin: string; 798evalp := 0; 799 800eval(s: string): int 801{ 802 evalin = s; 803 evalp = 0; 804 looked = -1; 805 { 806 v := expr(1); 807 if(evalp < len evalin) 808 raise Syntax; 809 return v; 810 }exception{ 811 Syntax => 812 error(sys->sprint("syntax error: %q %q", evalin[0: evalp], evalin[evalp:])); 813 return 0; 814 Badeval => 815 error(sys->sprint("zero divide in %q", evalin)); 816 return 0; 817 } 818} 819 820eval1(op: int, v1, v2: int): int raises Badeval 821{ 822 case op{ 823 '+' => return v1 + v2; 824 '-' => return v1 - v2; 825 '*' => return v1 * v2; 826 '%' => 827 if(v2 == 0) 828 raise Badeval; # division by zero 829 return v1 % v2; 830 '/' => 831 if(v2 == 0) 832 raise Badeval; # division by zero 833 return v1 / v2; 834 Opow => 835 if(v2 < 0) 836 raise Badeval; 837 return v1 ** v2; 838 '&' => return v1 & v2; 839 '|' => return v1 | v2; 840 '^' => return v1 ^ v2; 841 Olsh => return v1 << v2; 842 Orsh => return v1 >> v2; 843 Oand => return v1 && v2; 844 Oor => return v1 || v2; 845 '<' => return v1 < v2; 846 '>' => return v1 > v2; 847 Ole => return v1 <= v2; 848 Oge => return v1 >= v2; 849 One => return v1 != v2; 850 Oeq => return v1 == v2; 851 * => 852 sys->print("unknown op: %c\n", op); # shouldn't happen 853 raise Badeval; 854 } 855} 856 857priority(c: int): int 858{ 859 case c { 860 Oor => return 1; 861 Oand => return 2; 862 '|' => return 3; 863 '^' => return 4; 864 '&' => return 5; 865 Oeq or One => return 6; 866 '<' or '>' or Oge or Ole => return 7; 867 Olsh or Orsh => return 8; 868 '+' or '-' => return 9; 869 '*' or '/' or '%' => return 10; 870 Opow => return 11; 871 * => return 0; 872 } 873} 874 875rightassoc(c: int): int 876{ 877 return c == Opow; 878} 879 880expr(prec: int): int raises(Syntax, Badeval) 881{ 882 { 883 v := primary(); 884 while(priority(look()) >= prec){ 885 op := lex(); 886 r := priority(op) + !rightassoc(op); 887 v = eval1(op, v, expr(r)); 888 } 889 return v; 890 }exception{ 891 Syntax or Badeval => 892 raise; 893 } 894} 895 896primary(): int raises Syntax 897{ 898 { 899 case lex() { 900 '(' => 901 v := expr(1); 902 if(lex() != ')') 903 raise Syntax; 904 return v; 905 '+' => 906 return primary(); 907 '-' => 908 return -primary(); 909 '!' => 910 return !primary(); 911 '~' => 912 return ~primary(); 913 Odigits => 914 return yylval; 915 * => 916 raise Syntax; 917 } 918 }exception{ 919 Syntax => 920 raise; 921 } 922} 923 924yylval := 0; 925looked := -1; 926 927look(): int 928{ 929 looked = lex(); 930 return looked; 931} 932 933lex(): int 934{ 935 if((c := looked) >= 0){ 936 looked = -1; 937 return c; # if Odigits, assumes yylval untouched 938 } 939 while(evalp < len evalin && isspace(evalin[evalp])) 940 evalp++; 941 if(evalp >= len evalin) 942 return Oeof; 943 case c = evalin[evalp++] { 944 '*' => 945 return ifnext('*', Opow, '*'); 946 '>' => 947 return ifnext('=', Oge, ifnext('>', Orsh, '>')); 948 '<' => 949 return ifnext('=', Ole, ifnext('<', Olsh, '<')); 950 '=' => 951 return ifnext('=', Oeq, Oeq); 952 '!' => 953 return ifnext('=', One, '!'); 954 '|' => 955 return ifnext('|', Oor, '|'); 956 '&' => 957 return ifnext('&', Oand, '&'); 958 '0' to '9' => 959 evalp--; 960 n := 0; 961 while(evalp < len evalin && (c = evalin[evalp]) >= '0' && c <= '9'){ 962 n = n*10 + (c-'0'); 963 evalp++; 964 } 965 yylval = n; 966 return Odigits; 967 * => 968 return c; 969 } 970} 971 972ifnext(a, t, f: int): int 973{ 974 if(evalp < len evalin && evalin[evalp] == a){ 975 evalp++; 976 return t; 977 } 978 return f; 979} 980