ast@cs.vu.nl (09/07/89)
Here is a version of M4. I made a quick try and it doesn't seem to work. Will somebody who knows about this sort of program see if it can be ported. My suspicion is that not much work is needed. Andy Tanenbaum (ast@cs.vu.nl) : This is a shar archive. Extract with sh, not csh. : This archive ends with exit, so do not worry about trailing junk. : --------------------------- cut here -------------------------- PATH=/bin:/usr/bin:/usr/ucb echo Extracting 'MANIFEST' sed 's/^X//' > 'MANIFEST' << '+ END-OF-FILE ''MANIFEST' Xmdef.h - definitions and structures Xmain.c - this file: driver routines Xeval.c - general macro evaluator Xserv.c - service routines (doxxxx) Xmisc.c - miscellaneous routines Xexpr.c - expression parser Xlook.c - hash table management + END-OF-FILE MANIFEST chmod 'u=rw,g=r,o=r' 'MANIFEST' set `wc -c 'MANIFEST'` count=$1 case $count in 230) :;; *) echo 'Bad character count in ''MANIFEST' >&2 echo 'Count should be 230' >&2 esac echo Extracting 'README' sed 's/^X//' > 'README' << '+ END-OF-FILE ''README' XWhat you have here is a completely PD implementation of M4. It was Xoriginally written for the GNU project. This version was the last version Xbefore a major re-write took place. X XPd M4 is based on software tools macro, as described in the two tools Xbooks by Kernighan and Plauger. Although some serious changes have been Xmade, this version inherits the basic design problems of the original, Xhence the ugliness of the underlying code. X XPDness: X XThis code *is* PD. You (public) have all the rights to the code. [But Xthis also means you (singular) do not have any *extra* rights to the code, Xhence it is impossible for you to restrict the use and distribution of Xthis code (original) in any way.] X XDedication: X XThis posting is a dedication to an old 750 that started out running 4.1BSD Xand had 1.5 meg, 1 dz11, and 2 Rk07 drives. It was named yetti [sic] by Xaccident, and was managed by the author until its retirement two years Xago. [the name yetti now identifies a different machine] X XDistribution + misc: X XThe distribution includes a small test suite, the sources and a man page. Xtexinfo document is not included. The makefile is pretty simple. See the Xmakefile for configuration options. Try "make time" for some timing Xcomparisons between your un*x m4 and the pd m4. [It should be slighly Xslower than V7 m4, and slightly faster than SV m4]. Make sure to set MBIN Xto indicate the location of un*x m4. See the test suite (test.m4) for some Xadditional comments about pd m4 vs un*x m4. X XSome thoughts: X XM4 is a neat macro processor but probably a bit outdated by now. It does Xnot need gratuitous additions, or "features", but a complete re-write. As Xit stands, it is powerful enough for most macro processing needs. We have, Xfor example, used it to build a configuration language for DECNET under XVMS. It can be a handy software engineering tool under most circumstances, Xand can displace a lot of meaningless little hacks written in C, pascal or Xwhatever. [See some net postings for references.] X XSuggestions for hacking: X XIf you want to hack M4 further, you may wish to implement the SV m4 X"trace" facility, and extended (5-char) Comment/Quote definitions. This Xversion also needs some dynamicity for its data structures, and the Xability to handle multiple file names in the command line. If you want to Xadd "features", you may wish to first think about implementing the X"feature" as an M4 macro. If you really want to elevate this processor Xinto a more state-of the-art tool, than you should probably re-write it. X XFeedback: X XIf you have any important fixes and/or speed improvements, I am much Xinterested. I am also interested in hearing about any unique applica- Xtions of M4. I am NOT interested in gratuitous hacks or "neat" Xkitchen-sink features. X XAuthor: X Usenet: uunet!utai!yunexus!oz || oz@nexus.yorku.ca X Bitnet: oz@yulibra.BITNET X Phonet: [416] 736-5257 x 3976 X X Xenjoy. oz + END-OF-FILE README chmod 'u=rw,g=r,o=r' 'README' set `wc -c 'README'` count=$1 case $count in 2891) :;; *) echo 'Bad character count in ''README' >&2 echo 'Count should be 2891' >&2 esac echo Extracting 'ack.m4' sed 's/^X//' > 'ack.m4' << '+ END-OF-FILE ''ack.m4' Xdefine(ack, `ifelse($1,0,incr($2),$2,0,`ack(DECR($1),1)', X`ack(DECR($1), ack($1,DECR($2)))')') + END-OF-FILE ack.m4 chmod 'u=rw,g=r,o=r' 'ack.m4' set `wc -c 'ack.m4'` count=$1 case $count in 95) :;; *) echo 'Bad character count in ''ack.m4' >&2 echo 'Count should be 95' >&2 esac echo Extracting 'eval.c' sed 's/^X//' > 'eval.c' << '+ END-OF-FILE ''eval.c' X/* X * eval.c X * Facility: m4 macro processor X * by: oz X */ X X#include "mdef.h" X#include "extr.h" X Xextern ndptr lookup(); Xextern char *strsave(); Xextern char *mktemp(); X X/* X * eval - evaluate built-in macros. X * argc - number of elements in argv. X * argv - element vector : X * argv[0] = definition of a user X * macro or nil if built-in. X * argv[1] = name of the macro or X * built-in. X * argv[2] = parameters to user-defined X * . macro or built-in. X * . X * X * Note that the minimum value for argc is 3. A call in the form X * of macro-or-builtin() will result in: X * argv[0] = nullstr X * argv[1] = macro-or-builtin X * argv[2] = nullstr X * X */ X Xeval (argv, argc, td) Xregister char *argv[]; Xregister int argc; Xregister int td; X{ X register int c, n; X static int sysval; X X#ifdef DEBUG X printf("argc = %d\n", argc); X for (n = 0; n < argc; n++) X printf("argv[%d] = %s\n", n, argv[n]); X#endif X /* X * if argc == 3 and argv[2] is null, X * then we have macro-or-builtin() type call. X * We adjust argc to avoid further checking.. X * X */ X if (argc == 3 && !*(argv[2])) X argc--; X X switch (td & ~STATIC) { X X case DEFITYPE: X if (argc > 2) X dodefine(argv[2], (argc > 3) ? argv[3] : null); X break; X X case PUSDTYPE: X if (argc > 2) X dopushdef(argv[2], (argc > 3) ? argv[3] : null); X break; X X case DUMPTYPE: X dodump(argv, argc); X break; X X case EXPRTYPE: X /* X * doexpr - evaluate arithmetic expression X * X */ X if (argc > 2) X pbnum(expr(argv[2])); X break; X X case IFELTYPE: X if (argc > 4) X doifelse(argv, argc); X break; X X case IFDFTYPE: X /* X * doifdef - select one of two alternatives based X * on the existence of another definition X */ X if (argc > 3) { X if (lookup(argv[2]) != nil) X pbstr(argv[3]); X else if (argc > 4) X pbstr(argv[4]); X } X break; X X case LENGTYPE: X /* X * dolen - find the length of the argument X * X */ X if (argc > 2) X pbnum((argc > 2) ? strlen(argv[2]) : 0); X break; X X case INCRTYPE: X /* X * doincr - increment the value of the argument X * X */ X if (argc > 2) X pbnum(atoi(argv[2]) + 1); X break; X X case DECRTYPE: X /* X * dodecr - decrement the value of the argument X * X */ X if (argc > 2) X pbnum(atoi(argv[2]) - 1); X break; X X#if unix || vms X X case SYSCTYPE: X /* X * dosys - execute system command X * X */ X if (argc > 2) X sysval = system(argv[2]); X break; X X case SYSVTYPE: X /* X * dosysval - return value of the last system call. X * X */ X pbnum(sysval); X break; X#endif X X case INCLTYPE: X if (argc > 2) X if (!doincl(argv[2])) { X fprintf(stderr,"m4: %s: ",argv[2]); X error("cannot open for read."); X } X break; X X case SINCTYPE: X if (argc > 2) X (void) doincl(argv[2]); X break; X#ifdef EXTENDED X case PASTTYPE: X if (argc > 2) X if (!dopaste(argv[2])) { X fprintf(stderr,"m4: %s: ",argv[2]); X error("cannot open for read."); X } X break; X X case SPASTYPE: X if (argc > 2) X (void) dopaste(argv[2]); X break; X#endif X case CHNQTYPE: X dochq(argv, argc); X break; X X case CHNCTYPE: X dochc(argv, argc); X break; X X case SUBSTYPE: X /* X * dosub - select substring X * X */ X if (argc > 3) X dosub(argv,argc); X break; X X case SHIFTYPE: X /* X * doshift - push back all arguments except the X * first one (i.e. skip argv[2]) X */ X if (argc > 3) { X for (n = argc-1; n > 3; n--) { X putback(rquote); X pbstr(argv[n]); X putback(lquote); X putback(','); X } X putback(rquote); X pbstr(argv[3]); X putback(lquote); X } X break; X X case DIVRTYPE: X if (argc > 2 && (n = atoi(argv[2])) != 0) X dodiv(n); X else { X active = stdout; X oindex = 0; X } X break; X X case UNDVTYPE: X doundiv(argv, argc); X break; X X case DIVNTYPE: X /* X * dodivnum - return the number of current X * output diversion X * X */ X pbnum(oindex); X break; X X case UNDFTYPE: X /* X * doundefine - undefine a previously defined X * macro(s) or m4 keyword(s). X */ X if (argc > 2) X for (n = 2; n < argc; n++) X remhash(argv[n], ALL); X break; X X case POPDTYPE: X /* X * dopopdef - remove the topmost definitions of X * macro(s) or m4 keyword(s). X */ X if (argc > 2) X for (n = 2; n < argc; n++) X remhash(argv[n], TOP); X break; X X case MKTMTYPE: X /* X * dotemp - create a temporary file X * X */ X if (argc > 2) X pbstr(mktemp(argv[2])); X break; X X case TRNLTYPE: X /* X * dotranslit - replace all characters in the X * source string that appears in X * the "from" string with the corresponding X * characters in the "to" string. X * X */ X if (argc > 3) { X char temp[MAXTOK]; X if (argc > 4) X map(temp, argv[2], argv[3], argv[4]); X else X map(temp, argv[2], argv[3], null); X pbstr(temp); X } X else X if (argc > 2) X pbstr(argv[2]); X break; X X case INDXTYPE: X /* X * doindex - find the index of the second argument X * string in the first argument string. X * -1 if not present. X */ X pbnum((argc > 3) ? indx(argv[2], argv[3]) : -1); X break; X X case ERRPTYPE: X /* X * doerrp - print the arguments to stderr file X * X */ X if (argc > 2) { X for (n = 2; n < argc; n++) X fprintf(stderr,"%s ", argv[n]); X fprintf(stderr, "\n"); X } X break; X X case DNLNTYPE: X /* X * dodnl - eat-up-to and including newline X * X */ X while ((c = gpbc()) != '\n' && c != EOF) X ; X break; X X case M4WRTYPE: X /* X * dom4wrap - set up for wrap-up/wind-down activity X * X */ X m4wraps = (argc > 2) ? strsave(argv[2]) : null; X break; X X case EXITTYPE: X /* X * doexit - immediate exit from m4. X * X */ X exit((argc > 2) ? atoi(argv[2]) : 0); X break; X X case DEFNTYPE: X if (argc > 2) X for (n = 2; n < argc; n++) X dodefn(argv[n]); X break; X X default: X error("m4: major botch in eval."); X break; X } X} + END-OF-FILE eval.c chmod 'u=rw,g=r,o=r' 'eval.c' set `wc -c 'eval.c'` count=$1 case $count in 5707) :;; *) echo 'Bad character count in ''eval.c' >&2 echo 'Count should be 5707' >&2 esac echo Extracting 'expr.c' sed 's/^X//' > 'expr.c' << '+ END-OF-FILE ''expr.c' X X/* X * expression evaluator: performs a standard recursive X * descent parse to evaluate any expression permissible X * within the following grammar: X * X * expr : query EOS X * query : lor X * | lor "?" query ":" query X * lor : land { "||" land } X * land : bor { "&&" bor } X * bor : bxor { "|" bxor } X * bxor : band { "^" band } X * band : eql { "&" eql } X * eql : relat { eqrel relat } X * relat : shift { rel shift } X * shift : primary { shop primary } X * primary : term { addop term } X * term : unary { mulop unary } X * unary : factor X * | unop unary X * factor : constant X * | "(" query ")" X * constant: num X * | "'" CHAR "'" X * num : DIGIT X * | DIGIT num X * shop : "<<" X * | ">>" X * eqlrel : "=" X * | "==" X * | "!=" X * rel : "<" X * | ">" X * | "<=" X * | ">=" X * X * X * This expression evaluator is lifted from a public-domain X * C Pre-Processor included with the DECUS C Compiler distribution. X * It is hacked somewhat to be suitable for m4. X * X * Originally by: Mike Lutz X * Bob Harper X */ X X#define TRUE 1 X#define FALSE 0 X#define EOS (char) 0 X#define EQL 0 X#define NEQ 1 X#define LSS 2 X#define LEQ 3 X#define GTR 4 X#define GEQ 5 X#define OCTAL 8 X#define DECIMAL 10 X Xstatic char *nxtch; /* Parser scan pointer */ X X/* X * For longjmp X */ X#include <setjmp.h> Xstatic jmp_buf expjump; X X/* X * macros: X * X * ungetch - Put back the last character examined. X * getch - return the next character from expr string. X */ X#define ungetch() nxtch-- X#define getch() *nxtch++ X Xexpr(expbuf) Xchar *expbuf; X{ X register int rval; X X nxtch = expbuf; X if (setjmp(expjump) != 0) X return (FALSE); X rval = query(); X if (skipws() == EOS) X return(rval); X experr("Ill-formed expression"); X} X X/* X * query : lor | lor '?' query ':' query X * X */ Xquery() X{ X register int bool, true_val, false_val; X X bool = lor(); X if (skipws() != '?') { X ungetch(); X return(bool); X } X X true_val = query(); X if (skipws() != ':') X experr("Bad query"); X X false_val = query(); X return(bool ? true_val : false_val); X} X X/* X * lor : land { '||' land } X * X */ Xlor() X{ X register int c, vl, vr; X X vl = land(); X while ((c = skipws()) == '|' && getch() == '|') { X vr = land(); X vl = vl || vr; X } X X if (c == '|') X ungetch(); X ungetch(); X return(vl); X} X X/* X * land : bor { '&&' bor } X * X */ Xland() X{ X register int c, vl, vr; X X vl = bor(); X while ((c = skipws()) == '&' && getch() == '&') { X vr = bor(); X vl = vl && vr; X } X X if (c == '&') X ungetch(); X ungetch(); X return(vl); X} X X/* X * bor : bxor { '|' bxor } X * X */ Xbor() X{ X register int vl, vr, c; X X vl = bxor(); X while ((c = skipws()) == '|' && getch() != '|') { X ungetch(); X vr = bxor(); X vl |= vr; X } X X if (c == '|') X ungetch(); X ungetch(); X return(vl); X} X X/* X * bxor : band { '^' band } X * X */ Xbxor() X{ X register int vl, vr; X X vl = band(); X while (skipws() == '^') { X vr = band(); X vl ^= vr; X } X X ungetch(); X return(vl); X} X X/* X * band : eql { '&' eql } X * X */ Xband() X{ X register int vl, vr, c; X X vl = eql(); X while ((c = skipws()) == '&' && getch() != '&') { X ungetch(); X vr = eql(); X vl &= vr; X } X X if (c == '&') X ungetch(); X ungetch(); X return(vl); X} X X/* X * eql : relat { eqrel relat } X * X */ Xeql() X{ X register int vl, vr, rel; X X vl = relat(); X while ((rel = geteql()) != -1) { X vr = relat(); X X switch (rel) { X X case EQL: X vl = (vl == vr); X break; X case NEQ: X vl = (vl != vr); X break; X } X } X return(vl); X} X X/* X * relat : shift { rel shift } X * X */ Xrelat() X{ X register int vl, vr, rel; X X vl = shift(); X while ((rel = getrel()) != -1) { X X vr = shift(); X switch (rel) { X X case LEQ: X vl = (vl <= vr); X break; X case LSS: X vl = (vl < vr); X break; X case GTR: X vl = (vl > vr); X break; X case GEQ: X vl = (vl >= vr); X break; X } X } X return(vl); X} X X/* X * shift : primary { shop primary } X * X */ Xshift() X{ X register int vl, vr, c; X X vl = primary(); X while (((c = skipws()) == '<' || c == '>') && c == getch()) { X vr = primary(); X X if (c == '<') X vl <<= vr; X else X vl >>= vr; X } X X if (c == '<' || c == '>') X ungetch(); X ungetch(); X return(vl); X} X X/* X * primary : term { addop term } X * X */ Xprimary() X{ X register int c, vl, vr; X X vl = term(); X while ((c = skipws()) == '+' || c == '-') { X vr = term(); X if (c == '+') X vl += vr; X else X vl -= vr; X } X X ungetch(); X return(vl); X} X X/* X * <term> := <unary> { <mulop> <unary> } X * X */ Xterm() X{ X register int c, vl, vr; X X vl = unary(); X while ((c = skipws()) == '*' || c == '/' || c == '%') { X vr = unary(); X X switch (c) { X case '*': X vl *= vr; X break; X case '/': X vl /= vr; X break; X case '%': X vl %= vr; X break; X } X } X ungetch(); X return(vl); X} X X/* X * unary : factor | unop unary X * X */ Xunary() X{ X register int val, c; X X if ((c = skipws()) == '!' || c == '~' || c == '-') { X val = unary(); X X switch (c) { X case '!': X return(! val); X case '~': X return(~ val); X case '-': X return(- val); X } X } X X ungetch(); X return(factor()); X} X X/* X * factor : constant | '(' query ')' X * X */ Xfactor() X{ X register int val; X X if (skipws() == '(') { X val = query(); X if (skipws() != ')') X experr("Bad factor"); X return(val); X } X X ungetch(); X return(constant()); X} X X/* X * constant: num | 'char' X * X */ Xconstant() X{ X /* X * Note: constant() handles multi-byte constants X */ X X register int i; X register int value; X register char c; X int v[sizeof (int)]; X X if (skipws() != '\'') { X ungetch(); X return(num()); X } X for (i = 0; i < sizeof(int); i++) { X if ((c = getch()) == '\'') { X ungetch(); X break; X } X if (c == '\\') { X switch (c = getch()) { X case '0': X case '1': X case '2': X case '3': X case '4': X case '5': X case '6': X case '7': X ungetch(); X c = num(); X break; X case 'n': X c = 012; X break; X case 'r': X c = 015; X break; X case 't': X c = 011; X break; X case 'b': X c = 010; X break; X case 'f': X c = 014; X break; X } X } X v[i] = c; X } X if (i == 0 || getch() != '\'') X experr("Illegal character constant"); X for (value = 0; --i >= 0;) { X value <<= 8; X value += v[i]; X } X return(value); X} X X/* X * num : digit | num digit X * X */ Xnum() X{ X register int rval, c, base; X int ndig; X X base = ((c = skipws()) == '0') ? OCTAL : DECIMAL; X rval = 0; X ndig = 0; X while (c >= '0' && c <= (base == OCTAL ? '7' : '9')) { X rval *= base; X rval += (c - '0'); X c = getch(); X ndig++; X } X ungetch(); X if (ndig) X return(rval); X experr("Bad constant"); X} X X/* X * eqlrel : '=' | '==' | '!=' X * X */ Xgeteql() X{ X register int c1, c2; X X c1 = skipws(); X c2 = getch(); X X switch (c1) { X X case '=': X if (c2 != '=') X ungetch(); X return(EQL); X X case '!': X if (c2 == '=') X return(NEQ); X ungetch(); X ungetch(); X return(-1); X X default: X ungetch(); X ungetch(); X return(-1); X } X} X X/* X * rel : '<' | '>' | '<=' | '>=' X * X */ Xgetrel() X{ X register int c1, c2; X X c1 = skipws(); X c2 = getch(); X X switch (c1) { X X case '<': X if (c2 == '=') X return(LEQ); X ungetch(); X return(LSS); X X case '>': X if (c2 == '=') X return(GEQ); X ungetch(); X return(GTR); X X default: X ungetch(); X ungetch(); X return(-1); X } X} X X/* X * Skip over any white space and return terminating char. X */ Xskipws() X{ X register char c; X X while ((c = getch()) <= ' ' && c > EOS) X ; X return(c); X} X X/* X * Error handler - resets environment to eval(), prints an error, X * and returns FALSE. X */ Xexperr(msg) Xchar *msg; X{ X printf("mp: %s\n",msg); X longjmp(expjump, -1); /* Force eval() to return FALSE */ X} + END-OF-FILE expr.c chmod 'u=rw,g=r,o=r' 'expr.c' set `wc -c 'expr.c'` count=$1 case $count in 11531) :;; *) echo 'Bad character count in ''expr.c' >&2 echo 'Count should be 11531' >&2 esac echo Extracting 'extr.h' sed 's/^X//' > 'extr.h' << '+ END-OF-FILE ''extr.h' Xextern ndptr hashtab[]; /* hash table for macros etc. */ Xextern char buf[]; /* push-back buffer */ Xextern char *bp; /* first available character */ Xextern char *endpbb; /* end of push-back buffer */ Xextern stae mstack[]; /* stack of m4 machine */ Xextern char *ep; /* first free char in strspace */ Xextern char *endest; /* end of string space */ Xint sp; /* current m4 stack pointer */ Xint fp; /* m4 call frame pointer */ Xextern FILE *infile[]; /* input file stack (0=stdin) */ Xextern FILE *outfile[]; /* diversion array(0=bitbucket)*/ Xextern FILE *active; /* active output file pointer */ Xextern char *m4temp; /* filename for diversions */ Xextern int ilevel; /* input file stack pointer */ Xextern int oindex; /* diversion index.. */ Xextern char *null; /* as it says.. just a null.. */ Xextern char *m4wraps; /* m4wrap string default.. */ Xextern char lquote; /* left quote character (`) */ Xextern char rquote; /* right quote character (') */ Xextern char scommt; /* start character for comment */ Xextern char ecommt; /* end character for comment */ + END-OF-FILE extr.h chmod 'u=rw,g=r,o=r' 'extr.h' set `wc -c 'extr.h'` count=$1 case $count in 1136) :;; *) echo 'Bad character count in ''extr.h' >&2 echo 'Count should be 1136' >&2 esac echo Extracting 'hanoi.m4' sed 's/^X//' > 'hanoi.m4' << '+ END-OF-FILE ''hanoi.m4' Xdefine(hanoi, `trans(A, B, C, $1)') X Xdefine(moved,`move disk from $1 to $2 X') X Xdefine(trans, `ifelse($4,1,`moved($1,$2)', X `trans($1,$3,$2,DECR($4))moved($1,$2)trans($3,$2,$1,DECR($4))')') + END-OF-FILE hanoi.m4 chmod 'u=rw,g=r,o=r' 'hanoi.m4' set `wc -c 'hanoi.m4'` count=$1 case $count in 189) :;; *) echo 'Bad character count in ''hanoi.m4' >&2 echo 'Count should be 189' >&2 esac echo Extracting 'hash.m4' sed 's/^X//' > 'hash.m4' << '+ END-OF-FILE ''hash.m4' Xdnl This probably will not run on any m4 that cannot Xdnl handle char constants in eval. Xdnl Xchangequote(<,>) define(HASHVAL,99) dnl Xdefine(hash,<eval(str(substr($1,1),0)%HASHVAL)>) dnl Xdefine(str, X <ifelse($1,",$2, X <str(substr(<$1>,1),<eval($2+'substr($1,0,1)')>)>) X >) dnl Xdefine(KEYWORD,<$1,hash($1),>) dnl Xdefine(TSTART, X<struct prehash { X char *keyword; X int hashval; X} keytab[] = {>) dnl Xdefine(TEND,< "",0 X};>) dnl + END-OF-FILE hash.m4 chmod 'u=rw,g=r,o=r' 'hash.m4' set `wc -c 'hash.m4'` count=$1 case $count in 425) :;; *) echo 'Bad character count in ''hash.m4' >&2 echo 'Count should be 425' >&2 esac exit 0