Path: utzoo!censor!geac!yunexus!oz From: oz@yunexus.UUCP (Ozan Yigit) Newsgroups: comp.os.minix Subject: M4 (1 of 2) Message-ID: <3274@yunexus.UUCP> Date: 20 Aug 89 05:10:42 GMT Reply-To: oz@yunexus.UUCP (Ozan Yigit) Organization: York U. Communications Research & Development Lines: 2584 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh 'makefile' <<'END_OF_FILE' X# X# pd m4 [oz] X# X# -DEXTENDED X# if you like to get paste & spaste macros. X# -DVOID X# if your C compiler does NOT support void. X# -DGETOPT X# if you STILL do not have getopt in your library. X# [This means your library is broken. Fix it.] X# -DDUFFCP X# if you do not have fast memcpy in your library. X# XCC = rcc XCFLAGS = -O -lint -DEXTENDED XDEST = /usr/local/bin XMANL = /usr/man/manl XOBJS = main.o eval.o serv.o look.o misc.o expr.o XCSRC = main.c eval.c serv.c look.c misc.c expr.c XINCL = mdef.h extr.h patchlevel.h XMSRC = ack.m4 hanoi.m4 hash.m4 sqroot.m4 string.m4 test.m4 XDOCS = README MANIFEST m4.1 X XMBIN = /usr/bin X Xm4: ${OBJS} X @echo "loading m4.." X @cc -s -o m4 ${OBJS} X @size m4 X X${OBJS}: ${INCL} X Xlint: X lint -h ${CSRC} X Xinstall: m4 X install ./m4 ${DEST}/m4 X cp ./m4.1 ${MANL}/m4.l X Xdeinstall: X rm -f ${DEST}/m4 X rm -f ${MANL}/m4.l Xtime: m4 X @echo "timing comparisons.." X @echo "un*x m4:" X time ${MBIN}/m4 unxm4.out X @echo "pd m4:" X time ./m4 pdm4.out X @echo "un*x m4:" X time ${MBIN}/m4 unxm4.out X @echo "pd m4:" X time ./m4 pdm4.out X @echo "un*x m4:" X time ${MBIN}/m4 unxm4.out X @echo "pd m4:" X time ./m4 pdm4.out X @echo "output comparisons.." X -diff pdm4.out unxm4.out X @rm -f pdm4.out unxm4.out Xclean: X rm -f *.o core m4 *.out M4MAIN.SHAR M4MSRC.SHAR Xpack: X shar makefile ${INCL} ${CSRC} >M4MAIN.SHAR X shar ${MSRC} ${DOCS} patchlevel.h >M4MSRC.SHAR END_OF_FILE if test 1432 -ne `wc -c <'makefile'`; then echo shar: \"'makefile'\" unpacked with wrong size! fi # end of 'makefile' fi if test -f 'mdef.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'mdef.h'\" else echo shar: Extracting \"'mdef.h'\" \(4711 characters\) sed "s/^X//" >'mdef.h' <<'END_OF_FILE' X/* X * mdef.h X * Facility: m4 macro processor X * by: oz X */ X X X#ifndef unix X#define unix 0 X#endif X X#ifndef vms X#define vms 0 X#endif X X#if vms X X#include stdio X#include ctype X#include signal X X#else X X#include X#include X#include X X#endif X X/* X * X * m4 constants.. X * X */ X X#define MACRTYPE 1 X#define DEFITYPE 2 X#define EXPRTYPE 3 X#define SUBSTYPE 4 X#define IFELTYPE 5 X#define LENGTYPE 6 X#define CHNQTYPE 7 X#define SYSCTYPE 8 X#define UNDFTYPE 9 X#define INCLTYPE 10 X#define SINCTYPE 11 X#define PASTTYPE 12 X#define SPASTYPE 13 X#define INCRTYPE 14 X#define IFDFTYPE 15 X#define PUSDTYPE 16 X#define POPDTYPE 17 X#define SHIFTYPE 18 X#define DECRTYPE 19 X#define DIVRTYPE 20 X#define UNDVTYPE 21 X#define DIVNTYPE 22 X#define MKTMTYPE 23 X#define ERRPTYPE 24 X#define M4WRTYPE 25 X#define TRNLTYPE 26 X#define DNLNTYPE 27 X#define DUMPTYPE 28 X#define CHNCTYPE 29 X#define INDXTYPE 30 X#define SYSVTYPE 31 X#define EXITTYPE 32 X#define DEFNTYPE 33 X X#define STATIC 128 X X/* X * m4 special characters X */ X X#define ARGFLAG '$' X#define LPAREN '(' X#define RPAREN ')' X#define LQUOTE '`' X#define RQUOTE '\'' X#define COMMA ',' X#define SCOMMT '#' X#define ECOMMT '\n' X X/* X * definitions of diversion files. If the name of X * the file is changed, adjust UNIQUE to point to the X * wildcard (*) character in the filename. X */ X X#if unix X#define DIVNAM "/tmp/m4*XXXXXX" /* unix diversion files */ X#define UNIQUE 7 /* unique char location */ X#else X#if vms X#define DIVNAM "sys$login:m4*XXXXXX" /* vms diversion files */ X#define UNIQUE 12 /* unique char location */ X#else X#define DIVNAM "\M4*XXXXXX" /* msdos diversion files */ X#define UNIQUE 3 /* unique char location */ X#endif X#endif X X/* X * other important constants X */ X X#define EOS (char) 0 X#define MAXINP 10 /* maximum include files */ X#define MAXOUT 10 /* maximum # of diversions */ X#define MAXSTR 512 /* maximum size of string */ X#define BUFSIZE 4096 /* size of pushback buffer */ X#define STACKMAX 1024 /* size of call stack */ X#define STRSPMAX 4096 /* size of string space */ X#define MAXTOK MAXSTR /* maximum chars in a tokn */ X#define HASHSIZE 199 /* maximum size of hashtab */ X X#define ALL 1 X#define TOP 0 X X#define TRUE 1 X#define FALSE 0 X#define cycle for(;;) X X#ifdef VOID X#define void int /* define if void is void. */ X#endif X X/* X * m4 data structures X */ X Xtypedef struct ndblock *ndptr; X Xstruct ndblock { /* hastable structure */ X char *name; /* entry name.. */ X char *defn; /* definition.. */ X int type; /* type of the entry.. */ X ndptr nxtptr; /* link to next entry.. */ X}; X X#define nil ((ndptr) 0) X Xstruct keyblk { X char *knam; /* keyword name */ X int ktyp; /* keyword type */ X}; X Xtypedef union { /* stack structure */ X int sfra; /* frame entry */ X char *sstr; /* string entry */ X} stae; X X/* X * macros for readibility and/or speed X * X * gpbc() - get a possibly pushed-back character X * min() - select the minimum of two elements X * pushf() - push a call frame entry onto stack X * pushs() - push a string pointer onto stack X */ X#define gpbc() (bp > buf) ? *--bp : getc(infile[ilevel]) X#define min(x,y) ((x > y) ? y : x) X#define pushf(x) if (sp < STACKMAX) mstack[++sp].sfra = (x) X#define pushs(x) if (sp < STACKMAX) mstack[++sp].sstr = (x) X X/* X * . . X * | . | <-- sp | . | X * +-------+ +-----+ X * | arg 3 ----------------------->| str | X * +-------+ | . | X * | arg 2 ---PREVEP-----+ . X * +-------+ | X * . | | | X * +-------+ | +-----+ X * | plev | PARLEV +-------->| str | X * +-------+ | . | X * | type | CALTYP . X * +-------+ X * | prcf ---PREVFP--+ X * +-------+ | X * | . | PREVSP | X * . | X * +-------+ | X * | <----------+ X * +-------+ X * X */ X#define PARLEV (mstack[fp].sfra) X#define CALTYP (mstack[fp-1].sfra) X#define PREVEP (mstack[fp+3].sstr) X#define PREVSP (fp-3) X#define PREVFP (mstack[fp-2].sfra) END_OF_FILE if test 4711 -ne `wc -c <'mdef.h'`; then echo shar: \"'mdef.h'\" unpacked with wrong size! fi # end of 'mdef.h' fi if test -f 'extr.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'extr.h'\" else echo shar: Extracting \"'extr.h'\" \(1136 characters\) sed "s/^X//" >'extr.h' <<'END_OF_FILE' 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 if test 1136 -ne `wc -c <'extr.h'`; then echo shar: \"'extr.h'\" unpacked with wrong size! fi # end of 'extr.h' fi if test -f 'patchlevel.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'patchlevel.h'\" else echo shar: Extracting \"'patchlevel.h'\" \(21 characters\) sed "s/^X//" >'patchlevel.h' <<'END_OF_FILE' X#define PATCHLEVEL 1 END_OF_FILE if test 21 -ne `wc -c <'patchlevel.h'`; then echo shar: \"'patchlevel.h'\" unpacked with wrong size! fi # end of 'patchlevel.h' fi if test -f 'main.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'main.c'\" else echo shar: Extracting \"'main.c'\" \(11085 characters\) sed "s/^X//" >'main.c' <<'END_OF_FILE' X/* X * main.c X * Facility: m4 macro processor X * by: oz X */ X X#include "mdef.h" X X/* X * m4 - macro processor X * X * PD m4 is based on the macro tool distributed with the software X * tools (VOS) package, and described in the "SOFTWARE TOOLS" and X * "SOFTWARE TOOLS IN PASCAL" books. It has been expanded to include X * most of the command set of SysV m4, the standard UN*X macro processor. X * X * Since both PD m4 and UN*X m4 are based on SOFTWARE TOOLS macro, X * there may be certain implementation similarities between X * the two. The PD m4 was produced without ANY references to m4 X * sources. X * X * References: X * X * Software Tools distribution: macro X * X * Kernighan, Brian W. and P. J. Plauger, SOFTWARE X * TOOLS IN PASCAL, Addison-Wesley, Mass. 1981 X * X * Kernighan, Brian W. and P. J. Plauger, SOFTWARE X * TOOLS, Addison-Wesley, Mass. 1976 X * X * Kernighan, Brian W. and Dennis M. Ritchie, X * THE M4 MACRO PROCESSOR, Unix Programmer's Manual, X * Seventh Edition, Vol. 2, Bell Telephone Labs, 1979 X * X * System V man page for M4 X * X * Modification History: X * X * Jan 28 1986 Oz Break the whole thing into little X * pieces, for easier (?) maintenance. X * X * Dec 12 1985 Oz Optimize the code, try to squeeze X * few microseconds out.. X * X * Dec 05 1985 Oz Add getopt interface, define (-D), X * undefine (-U) options. X * X * Oct 21 1985 Oz Clean up various bugs, add comment handling. X * X * June 7 1985 Oz Add some of SysV m4 stuff (m4wrap, pushdef, X * popdef, decr, shift etc.). X * X * June 5 1985 Oz Initial cut. X * X * Implementation Notes: X * X * [1] PD m4 uses a different (and simpler) stack mechanism than the one X * described in Software Tools and Software Tools in Pascal books. X * The triple stack nonsense is replaced with a single stack containing X * the call frames and the arguments. Each frame is back-linked to a X * previous stack frame, which enables us to rewind the stack after X * each nested call is completed. Each argument is a character pointer X * to the beginning of the argument string within the string space. X * The only exceptions to this are (*) arg 0 and arg 1, which are X * the macro definition and macro name strings, stored dynamically X * for the hash table. X * X * . . X * | . | <-- sp | . | X * +-------+ +-----+ X * | arg 3 ------------------------------->| str | X * +-------+ | . | X * | arg 2 --------------+ . X * +-------+ | X * * | | | X * +-------+ | +-----+ X * | plev | <-- fp +---------------->| str | X * +-------+ | . | X * | type | . X * +-------+ X * | prcf -----------+ plev: paren level X * +-------+ | type: call type X * | . | | prcf: prev. call frame X * . | X * +-------+ | X * | <----------+ X * +-------+ X * X * [2] We have three types of null values: X * X * nil - nodeblock pointer type 0 X * null - null string ("") X * NULL - Stdio-defined NULL X * X */ X Xndptr hashtab[HASHSIZE]; /* hash table for macros etc. */ Xchar buf[BUFSIZE]; /* push-back buffer */ Xchar *bp = buf; /* first available character */ Xchar *endpbb = buf+BUFSIZE; /* end of push-back buffer */ Xstae mstack[STACKMAX+1]; /* stack of m4 machine */ Xchar strspace[STRSPMAX+1]; /* string space for evaluation */ Xchar *ep = strspace; /* first free char in strspace */ Xchar *endest= strspace+STRSPMAX;/* end of string space */ Xint sp; /* current m4 stack pointer */ Xint fp; /* m4 call frame pointer */ XFILE *infile[MAXINP]; /* input file stack (0=stdin) */ XFILE *outfile[MAXOUT]; /* diversion array(0=bitbucket)*/ XFILE *active; /* active output file pointer */ Xchar *m4temp; /* filename for diversions */ Xint ilevel = 0; /* input file stack pointer */ Xint oindex = 0; /* diversion index.. */ Xchar *null = ""; /* as it says.. just a null.. */ Xchar *m4wraps = ""; /* m4wrap string default.. */ Xchar lquote = LQUOTE; /* left quote character (`) */ Xchar rquote = RQUOTE; /* right quote character (') */ Xchar scommt = SCOMMT; /* start character for comment */ Xchar ecommt = ECOMMT; /* end character for comment */ Xstruct keyblk keywrds[] = { /* m4 keywords to be installed */ X "include", INCLTYPE, X "sinclude", SINCTYPE, X "define", DEFITYPE, X "defn", DEFNTYPE, X "divert", DIVRTYPE, X "expr", EXPRTYPE, X "eval", EXPRTYPE, X "substr", SUBSTYPE, X "ifelse", IFELTYPE, X "ifdef", IFDFTYPE, X "len", LENGTYPE, X "incr", INCRTYPE, X "decr", DECRTYPE, X "dnl", DNLNTYPE, X "changequote", CHNQTYPE, X "changecom", CHNCTYPE, X "index", INDXTYPE, X#ifdef EXTENDED X "paste", PASTTYPE, X "spaste", SPASTYPE, X#endif X "popdef", POPDTYPE, X "pushdef", PUSDTYPE, X "dumpdef", DUMPTYPE, X "shift", SHIFTYPE, X "translit", TRNLTYPE, X "undefine", UNDFTYPE, X "undivert", UNDVTYPE, X "divnum", DIVNTYPE, X "maketemp", MKTMTYPE, X "errprint", ERRPTYPE, X "m4wrap", M4WRTYPE, X "m4exit", EXITTYPE, X#if unix || vms X "syscmd", SYSCTYPE, X "sysval", SYSVTYPE, X#endif X#if unix X "unix", MACRTYPE, X#else X#if vms X "vms", MACRTYPE, X#endif X#endif X}; X X#define MAXKEYS (sizeof(keywrds)/sizeof(struct keyblk)) X Xextern ndptr lookup(); Xextern ndptr addent(); Xextern int onintr(); X Xextern char *malloc(); Xextern char *mktemp(); X Xextern int optind; Xextern char *optarg; X Xmain(argc,argv) Xchar *argv[]; X{ X register int c; X register int n; X char *p; X X if (signal(SIGINT, SIG_IGN) != SIG_IGN) X signal(SIGINT, onintr); X#ifdef NONZEROPAGES X initm4(); X#endif X initkwds(); X X while ((c = getopt(argc, argv, "tD:U:o:")) != EOF) X switch(c) { X X case 'D': /* define something..*/ X for (p = optarg; *p; p++) X if (*p == '=') X break; X if (*p) X *p++ = EOS; X dodefine(optarg, p); X break; X case 'U': /* undefine... */ X remhash(optarg, TOP); X break; X case 'o': /* specific output */ X case '?': X default: X usage(); X } X X infile[0] = stdin; /* default input (naturally) */ X active = stdout; /* default active output */ X m4temp = mktemp(DIVNAM); /* filename for diversions */ X X sp = -1; /* stack pointer initialized */ X fp = 0; /* frame pointer initialized */ X X macro(); /* get some work done here */ X X if (*m4wraps) { /* anything for rundown ?? */ X ilevel = 0; /* in case m4wrap includes.. */ X putback(EOF); /* eof is a must !! */ X pbstr(m4wraps); /* user-defined wrapup act */ X macro(); /* last will and testament */ X } X else /* default wrap-up: undivert */ X for (n = 1; n < MAXOUT; n++) X if (outfile[n] != NULL) X getdiv(n); X X /* remove bitbucket if used */ X if (outfile[0] != NULL) { X (void) fclose(outfile[0]); X m4temp[UNIQUE] = '0'; X#if vms X (void) remove(m4temp); X#else X (void) unlink(m4temp); X#endif X } X X exit(0); X} X Xndptr inspect(); /* forward ... */ X X/* X * macro - the work horse.. X * X */ Xmacro() { X char token[MAXTOK]; X register char *s; X register int t, l; X register ndptr p; X register int nlpar; X X cycle { X if ((t = gpbc()) == '_' || isalpha(t)) { X putback(t); X if ((p = inspect(s = token)) == nil) { X if (sp < 0) X while (*s) X putc(*s++, active); X else X while (*s) X chrsave(*s++); X } X else { X /* X * real thing.. First build a call frame: X * X */ X pushf(fp); /* previous call frm */ X pushf(p->type); /* type of the call */ X pushf(0); /* parenthesis level */ X fp = sp; /* new frame pointer */ X /* X * now push the string arguments: X * X */ X pushs(p->defn); /* defn string */ X pushs(p->name); /* macro name */ X pushs(ep); /* start next..*/ X X putback(l = gpbc()); X if (l != LPAREN) { /* add bracks */ X putback(RPAREN); X putback(LPAREN); X } X } X } X else if (t == EOF) { X if (sp > -1) X error("m4: unexpected end of input"); X if (--ilevel < 0) X break; /* all done thanks.. */ X (void) fclose(infile[ilevel+1]); X continue; X } X /* X * non-alpha single-char token seen.. X * [the order of else if .. stmts is X * important.] X * X */ X else if (t == lquote) { /* strip quotes */ X nlpar = 1; X do { X if ((l = gpbc()) == rquote) X nlpar--; X else if (l == lquote) X nlpar++; X else if (l == EOF) X error("m4: missing right quote"); X if (nlpar > 0) { X if (sp < 0) X putc(l, active); X else X chrsave(l); X } X } X while (nlpar != 0); X } X X else if (sp < 0) { /* not in a macro at all */ X if (t == scommt) { /* comment handling here */ X putc(t, active); X while ((t = gpbc()) != ecommt) X putc(t, active); X } X putc(t, active); /* output directly.. */ X } X X else switch(t) { X X case LPAREN: X if (PARLEV > 0) X chrsave(t); X while (isspace(l = gpbc())) X ; /* skip blank, tab, nl.. */ X putback(l); X PARLEV++; X break; X X case RPAREN: X if (--PARLEV > 0) X chrsave(t); X else { /* end of argument list */ X chrsave(EOS); X X if (sp == STACKMAX) X error("m4: internal stack overflow"); X X if (CALTYP == MACRTYPE) X expand(mstack+fp+1, sp-fp); X else X eval(mstack+fp+1, sp-fp, CALTYP); X X ep = PREVEP; /* flush strspace */ X sp = PREVSP; /* previous sp.. */ X fp = PREVFP; /* rewind stack...*/ X } X break; X X case COMMA: X if (PARLEV == 1) { X chrsave(EOS); /* new argument */ X while (isspace(l = gpbc())) X ; X putback(l); X pushs(ep); X } X break; X default: X chrsave(t); /* stack the char */ X break; X } X } X} X X X/* X * build an input token.. X * consider only those starting with _ or A-Za-z. This is a X * combo with lookup to speed things up. X */ Xndptr Xinspect(tp) Xregister char *tp; X{ X register int h = 0; X register char c; X register char *name = tp; X register char *etp = tp+MAXTOK; X register ndptr p; X X while (tp < etp && (isalnum(c = gpbc()) || c == '_')) X h += (*tp++ = c); X putback(c); X if (tp == etp) X error("m4: token too long"); X *tp = EOS; X for (p = hashtab[h%HASHSIZE]; p != nil; p = p->nxtptr) X if (strcmp(name, p->name) == 0) X break; X return(p); X} X X#ifdef NONZEROPAGES X/* X * initm4 - initialize various tables. Useful only if your system X * does not know anything about demand-zero pages. X * X */ Xinitm4() X{ X register int i; X X for (i = 0; i < HASHSIZE; i++) X hashtab[i] = nil; X for (i = 0; i < MAXOUT; i++) X outfile[i] = NULL; X} X#endif X X/* X * initkwds - initialise m4 keywords as fast as possible. X * This very similar to install, but without certain overheads, X * such as calling lookup. Malloc is not used for storing the X * keyword strings, since we simply use the static pointers X * within keywrds block. We also assume that there is enough memory X * to at least install the keywords (i.e. malloc won't fail). X * X */ Xinitkwds() { X register int i; X register int h; X register ndptr p; X X for (i = 0; i < MAXKEYS; i++) { X h = hash(keywrds[i].knam); X p = (ndptr) malloc(sizeof(struct ndblock)); X p->nxtptr = hashtab[h]; X hashtab[h] = p; X p->name = keywrds[i].knam; X p->defn = null; X p->type = keywrds[i].ktyp | STATIC; X } X} END_OF_FILE if test 11085 -ne `wc -c <'main.c'`; then echo shar: \"'main.c'\" unpacked with wrong size! fi # end of 'main.c' fi if test -f 'eval.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'eval.c'\" else echo shar: Extracting \"'eval.c'\" \(5707 characters\) sed "s/^X//" >'eval.c' <<'END_OF_FILE' 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 if test 5707 -ne `wc -c <'eval.c'`; then echo shar: \"'eval.c'\" unpacked with wrong size! fi # end of 'eval.c' fi if test -f 'serv.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'serv.c'\" else echo shar: Extracting \"'serv.c'\" \(11554 characters\) sed "s/^X//" >'serv.c' <<'END_OF_FILE' X/* X * serv.c X * Facility: m4 macro processor X * by: oz X */ X X#include "mdef.h" X#include "extr.h" X Xextern ndptr lookup(); Xextern ndptr addent(); Xextern char *strsave(); X Xchar *dumpfmt = "`%s'\t`%s'\n"; /* format string for dumpdef */ X X/* X * expand - user-defined macro expansion X * X */ Xexpand(argv, argc) Xregister char *argv[]; Xregister int argc; X{ X register char *t; X register char *p; X register int n; X register int argno; X X t = argv[0]; /* defn string as a whole */ X p = t; X while (*p) X p++; X p--; /* last character of defn */ X while (p > t) { X if (*(p-1) != ARGFLAG) X putback(*p); X else { X switch (*p) { X X case '#': X pbnum(argc-2); X break; 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 case '8': X case '9': X if ((argno = *p - '0') < argc-1) X pbstr(argv[argno+1]); X break; X case '*': X for (n = argc - 1; n > 2; n--) { X pbstr(argv[n]); X putback(','); X } X pbstr(argv[2]); X break; X default : X putback(*p); X break; X } X p--; X } X p--; X } X if (p == t) /* do last character */ X putback(*p); X} X X/* X * dodefine - install definition in the table X * X */ Xdodefine(name, defn) Xregister char *name; Xregister char *defn; X{ X register ndptr p; X X if (!*name) X error("m4: null definition."); X if (strcmp(name, defn) == 0) X error("m4: recursive definition."); X if ((p = lookup(name)) == nil) X p = addent(name); X else if (p->defn != null) X free(p->defn); X if (!*defn) X p->defn = null; X else X p->defn = strsave(defn); X p->type = MACRTYPE; X} X X/* X * dodefn - push back a quoted definition of X * the given name. X */ X Xdodefn(name) Xchar *name; X{ X register ndptr p; X X if ((p = lookup(name)) != nil && p->defn != null) { X putback(rquote); X pbstr(p->defn); X putback(lquote); X } X} X X/* X * dopushdef - install a definition in the hash table X * without removing a previous definition. Since X * each new entry is entered in *front* of the X * hash bucket, it hides a previous definition from X * lookup. X */ Xdopushdef(name, defn) Xregister char *name; Xregister char *defn; X{ X register ndptr p; X X if (!*name) X error("m4: null definition"); X if (strcmp(name, defn) == 0) X error("m4: recursive definition."); X p = addent(name); X if (!*defn) X p->defn = null; X else X p->defn = strsave(defn); X p->type = MACRTYPE; X} X X/* X * dodumpdef - dump the specified definitions in the hash X * table to stderr. If nothing is specified, the entire X * hash table is dumped. X * X */ Xdodump(argv, argc) Xregister char *argv[]; Xregister int argc; X{ X register int n; X ndptr p; X X if (argc > 2) { X for (n = 2; n < argc; n++) X if ((p = lookup(argv[n])) != nil) X fprintf(stderr, dumpfmt, p->name, X p->defn); X } X else { X for (n = 0; n < HASHSIZE; n++) X for (p = hashtab[n]; p != nil; p = p->nxtptr) X fprintf(stderr, dumpfmt, p->name, X p->defn); X } X} X X/* X * doifelse - select one of two alternatives - loop. X * X */ Xdoifelse(argv,argc) Xregister char *argv[]; Xregister int argc; X{ X cycle { X if (strcmp(argv[2], argv[3]) == 0) X pbstr(argv[4]); X else if (argc == 6) X pbstr(argv[5]); X else if (argc > 6) { X argv += 3; X argc -= 3; X continue; X } X break; X } X} X X/* X * doinclude - include a given file. X * X */ Xdoincl(ifile) Xchar *ifile; X{ X if (ilevel+1 == MAXINP) X error("m4: too many include files."); X if ((infile[ilevel+1] = fopen(ifile, "r")) != NULL) { X ilevel++; X return (1); X } X else X return (0); X} X X#ifdef EXTENDED X/* X * dopaste - include a given file without any X * macro processing. X */ Xdopaste(pfile) Xchar *pfile; X{ X FILE *pf; X register int c; X X if ((pf = fopen(pfile, "r")) != NULL) { X while((c = getc(pf)) != EOF) X putc(c, active); X (void) fclose(pf); X return(1); X } X else X return(0); X} X#endif X X/* X * dochq - change quote characters X * X */ Xdochq(argv, argc) Xregister char *argv[]; Xregister int argc; X{ X if (argc > 2) { X if (*argv[2]) X lquote = *argv[2]; X if (argc > 3) { X if (*argv[3]) X rquote = *argv[3]; X } X else X rquote = lquote; X } X else { X lquote = LQUOTE; X rquote = RQUOTE; X } X} X X/* X * dochc - change comment characters X * X */ Xdochc(argv, argc) Xregister char *argv[]; Xregister int argc; X{ X if (argc > 2) { X if (*argv[2]) X scommt = *argv[2]; X if (argc > 3) { X if (*argv[3]) X ecommt = *argv[3]; X } X else X ecommt = ECOMMT; X } X else { X scommt = SCOMMT; X ecommt = ECOMMT; X } X} X X/* X * dodivert - divert the output to a temporary file X * X */ Xdodiv(n) Xregister int n; X{ X if (n < 0 || n >= MAXOUT) X n = 0; /* bitbucket */ X if (outfile[n] == NULL) { X m4temp[UNIQUE] = n + '0'; X if ((outfile[n] = fopen(m4temp, "w")) == NULL) X error("m4: cannot divert."); X } X oindex = n; X active = outfile[n]; X} X X/* X * doundivert - undivert a specified output, or all X * other outputs, in numerical order. X */ Xdoundiv(argv, argc) Xregister char *argv[]; Xregister int argc; X{ X register int ind; X register int n; X X if (argc > 2) { X for (ind = 2; ind < argc; ind++) { X n = atoi(argv[ind]); X if (n > 0 && n < MAXOUT && outfile[n] != NULL) X getdiv(n); X X } X } X else X for (n = 1; n < MAXOUT; n++) X if (outfile[n] != NULL) X getdiv(n); X} X X/* X * dosub - select substring X * X */ Xdosub (argv, argc) Xregister char *argv[]; Xregister int argc; X{ X register char *ap, *fc, *k; X register int nc; X X if (argc < 5) X nc = MAXTOK; X else X#ifdef EXPR X nc = expr(argv[4]); X#else X nc = atoi(argv[4]); X#endif X ap = argv[2]; /* target string */ X#ifdef EXPR X fc = ap + expr(argv[3]); /* first char */ X#else X fc = ap + atoi(argv[3]); /* first char */ X#endif X if (fc >= ap && fc < ap+strlen(ap)) X for (k = fc+min(nc,strlen(fc))-1; k >= fc; k--) X putback(*k); X} X X/* X * map: X * map every character of s1 that is specified in from X * into s3 and replace in s. (source s1 remains untouched) X * X * This is a standard implementation of map(s,from,to) function of ICON X * language. Within mapvec, we replace every character of "from" with X * the corresponding character in "to". If "to" is shorter than "from", X * than the corresponding entries are null, which means that those X * characters dissapear altogether. Furthermore, imagine X * map(dest, "sourcestring", "srtin", "rn..*") type call. In this case, X * `s' maps to `r', `r' maps to `n' and `n' maps to `*'. Thus, `s' X * ultimately maps to `*'. In order to achieve this effect in an efficient X * manner (i.e. without multiple passes over the destination string), we X * loop over mapvec, starting with the initial source character. if the X * character value (dch) in this location is different than the source X * character (sch), sch becomes dch, once again to index into mapvec, until X * the character value stabilizes (i.e. sch = dch, in other words X * mapvec[n] == n). Even if the entry in the mapvec is null for an ordinary X * character, it will stabilize, since mapvec[0] == 0 at all times. At the X * end, we restore mapvec* back to normal where mapvec[n] == n for X * 0 <= n <= 127. This strategy, along with the restoration of mapvec, is X * about 5 times faster than any algorithm that makes multiple passes over X * destination string. X * X */ X Xmap(dest,src,from,to) Xregister char *dest; Xregister char *src; Xregister char *from; Xregister char *to; X{ X register char *tmp; X register char sch, dch; X static char mapvec[128] = { X 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, X 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, X 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, X 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, X 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, X 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, X 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, X 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, X 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, X 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, X 120, 121, 122, 123, 124, 125, 126, 127 X }; X X if (*src) { X tmp = from; X /* X * create a mapping between "from" and "to" X */ X while (*from) X mapvec[*from++] = (*to) ? *to++ : (char) 0; X X while (*src) { X sch = *src++; X dch = mapvec[sch]; X while (dch != sch) { X sch = dch; X dch = mapvec[sch]; X } X if (*dest = dch) X dest++; X } X /* X * restore all the changed characters X */ X while (*tmp) { X mapvec[*tmp] = *tmp; X tmp++; X } X } X *dest = (char) 0; X} END_OF_FILE if test 11554 -ne `wc -c <'serv.c'`; then echo shar: \"'serv.c'\" unpacked with wrong size! fi # end of 'serv.c' fi if test -f 'look.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'look.c'\" else echo shar: Extracting \"'look.c'\" \(1617 characters\) sed "s/^X//" >'look.c' <<'END_OF_FILE' X/* X * look.c X * Facility: m4 macro processor X * by: oz X */ X X#include "mdef.h" X#include "extr.h" X Xextern char *strsave(); X X/* X * hash - compute hash value using the proverbial X * hashing function. Taken from K&R. X */ Xhash (name) Xregister char *name; X{ X register int h = 0; X while (*name) X h += *name++; X return (h % HASHSIZE); X} X X/* X * lookup - find name in the hash table X * X */ Xndptr lookup(name) Xchar *name; X{ X register ndptr p; X X for (p = hashtab[hash(name)]; p != nil; p = p->nxtptr) X if (strcmp(name, p->name) == 0) X break; X return (p); X} X X/* X * addent - hash and create an entry in the hash X * table. The new entry is added in front X * of a hash bucket. X */ Xndptr addent(name) Xchar *name; X{ X register int h; X ndptr p; X X h = hash(name); X if ((p = (ndptr) malloc(sizeof(struct ndblock))) != NULL) { X p->nxtptr = hashtab[h]; X hashtab[h] = p; X p->name = strsave(name); X } X else X error("m4: no more memory."); X return p; X} X X/* X * remhash - remove an entry from the hashtable X * X */ Xremhash(name, all) Xchar *name; Xint all; X{ X register int h; X register ndptr xp, tp, mp; X X h = hash(name); X mp = hashtab[h]; X tp = nil; X while (mp != nil) { X if (strcmp(mp->name, name) == 0) { X mp = mp->nxtptr; X if (tp == nil) { X freent(hashtab[h]); X hashtab[h] = mp; X } X else { X xp = tp->nxtptr; X tp->nxtptr = mp; X freent(xp); X } X if (!all) X break; X } X else { X tp = mp; X mp = mp->nxtptr; X } X } X} X X/* X * freent - free a hashtable information block X * X */ Xfreent(p) Xndptr p; X{ X if (!(p->type & STATIC)) { X free(p->name); X if (p->defn != null) X free(p->defn); X } X free(p); X} X END_OF_FILE if test 1617 -ne `wc -c <'look.c'`; then echo shar: \"'look.c'\" unpacked with wrong size! fi # end of 'look.c' fi if test -f 'misc.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'misc.c'\" else echo shar: Extracting \"'misc.c'\" \(5005 characters\) sed "s/^X//" >'misc.c' <<'END_OF_FILE' X/* X * misc.c X * Facility: m4 macro processor X * by: oz X */ X X#include "mdef.h" X#include "extr.h" X Xextern char *malloc(); X X/* X * indx - find the index of second str in the X * first str. X */ Xindx(s1, s2) Xchar *s1; Xchar *s2; X{ X register char *t; X register char *p; X register char *m; X X for (p = s1; *p; p++) { X for (t = p, m = s2; *m && *m == *t; m++, t++) X ; X if (!*m) X return(p - s1); X } X return (-1); X} X X/* X * putback - push character back onto input X * X */ Xputback (c) Xchar c; X{ X if (bp < endpbb) X *bp++ = c; X else X error("m4: too many characters pushed back"); X} X X/* X * pbstr - push string back onto input X * putback is replicated to improve X * performance. X * X */ Xpbstr(s) Xregister char *s; X{ X register char *es; X register char *zp; X X es = s; X zp = bp; X X while (*es) X es++; X es--; X while (es >= s) X if (zp < endpbb) X *zp++ = *es--; X if ((bp = zp) == endpbb) X error("m4: too many characters pushed back"); X} X X/* X * pbnum - convert number to string, push back on input. X * X */ Xpbnum (n) Xint n; X{ X register int num; X X num = (n < 0) ? -n : n; X do { X putback(num % 10 + '0'); X } X while ((num /= 10) > 0); X X if (n < 0) putback('-'); X} X X/* X * chrsave - put single char on string space X * X */ Xchrsave (c) Xchar c; X{ X/*** if (sp < 0) X putc(c, active); X else ***/ if (ep < endest) X *ep++ = c; X else X error("m4: string space overflow"); X} X X/* X * getdiv - read in a diversion file, and X * trash it. X */ Xgetdiv(ind) { X register int c; X register FILE *dfil; X X if (active == outfile[ind]) X error("m4: undivert: diversion still active."); X (void) fclose(outfile[ind]); X outfile[ind] = NULL; X m4temp[UNIQUE] = ind + '0'; X if ((dfil = fopen(m4temp, "r")) == NULL) X error("m4: cannot undivert."); X else X while((c = getc(dfil)) != EOF) X putc(c, active); X (void) fclose(dfil); X X#if vms X if (remove(m4temp)) X#else X if (unlink(m4temp) == -1) X#endif X error("m4: cannot unlink."); X} X X/* X * Very fatal error. Close all files X * and die hard. X */ Xerror(s) Xchar *s; X{ X killdiv(); X fprintf(stderr,"%s\n",s); X exit(1); X} X X/* X * Interrupt handling X */ Xstatic char *msg = "\ninterrupted."; X Xonintr() { X error(msg); X} X X/* X * killdiv - get rid of the diversion files X * X */ Xkilldiv() { X register int n; X X for (n = 0; n < MAXOUT; n++) X if (outfile[n] != NULL) { X (void) fclose (outfile[n]); X m4temp[UNIQUE] = n + '0'; X#if vms X (void) remove (m4temp); X#else X (void) unlink (m4temp); X#endif X } X} X X/* X * save a string somewhere.. X * X */ Xchar *strsave(s) Xchar *s; X{ X register int n; X char *p; X X if ((p = malloc (n = strlen(s)+1)) != NULL) X (void) memcpy(p, s, n); X return (p); X} X Xusage() { X fprintf(stderr, "Usage: m4 [-Dname[=val]] [-Uname]\n"); X exit(1); X} X X#ifdef GETOPT X/* X * H. Spencer getopt - get option letter from argv X * X * X#include X * X */ X Xchar *optarg; /* Global argument pointer. */ Xint optind = 0; /* Global argv index. */ X Xstatic char *scan = NULL; /* Private scan pointer. */ X Xextern char *index(); X Xint Xgetopt(argc, argv, optstring) Xint argc; Xchar *argv[]; Xchar *optstring; X{ X register char c; X register char *place; X X optarg = NULL; X X if (scan == NULL || *scan == '\0') { X if (optind == 0) X optind++; X X if (optind >= argc || argv[optind][0] != '-' || argv[optind][1] == '\0') X return(EOF); X if (strcmp(argv[optind], "--")==0) { X optind++; X return(EOF); X } X X scan = argv[optind]+1; X optind++; X } X X c = *scan++; X place = index(optstring, c); X X if (place == NULL || c == ':') { X fprintf(stderr, "%s: unknown option -%c\n", argv[0], c); X return('?'); X } X X place++; X if (*place == ':') { X if (*scan != '\0') { X optarg = scan; X scan = NULL; X } else { X optarg = argv[optind]; X optind++; X } X } X X return(c); X} X X#endif X X#ifdef DUFFCP X/* X * This code uses Duff's Device (tm Tom Duff) X * to unroll the copying loop: X * while (count-- > 0) X * *to++ = *from++; X */ X X#define COPYBYTE *to++ = *from++ X Xmemcpy(to, from, count) Xregister char *from, *to; Xregister int count; X{ X if (count > 0) { X register int loops = (count+8-1) >> 3; /* div 8 round up */ X X switch (count&(8-1)) { /* mod 8 */ X case 0: do { X COPYBYTE; X case 7: COPYBYTE; X case 6: COPYBYTE; X case 5: COPYBYTE; X case 4: COPYBYTE; X case 3: COPYBYTE; X case 2: COPYBYTE; X case 1: COPYBYTE; X } while (--loops > 0); X } X X } X} X X#endif END_OF_FILE if test 5005 -ne `wc -c <'misc.c'`; then echo shar: \"'misc.c'\" unpacked with wrong size! fi # end of 'misc.c' fi if test -f 'expr.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'expr.c'\" else echo shar: Extracting \"'expr.c'\" \(11531 characters\) sed "s/^X//" >'expr.c' <<'END_OF_FILE' 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 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 * := { } 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 if test 11531 -ne `wc -c <'expr.c'`; then echo shar: \"'expr.c'\" unpacked with wrong size! fi # end of 'expr.c' fi echo shar: End of shell archive. exit 0 -- The king: If there's no meaning Usenet: oz@nexus.yorku.ca in it, that saves a world of trouble ......!uunet!utai!yunexus!oz you know, as we needn't try to find any. Bitnet: oz@[yulibra|yuyetti] Lewis Carroll (Alice in Worderland) Phonet: +1 416 736-5257x3976