v13i038: Public domain M4 macro processor, Part01/02
Rich Salz
Posting-number: Volume 13, Issue 38
Archive-name: m4/part01
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# makefile
# mdef.h
# extr.h
# main.c
# eval.c
# serv.c
# look.c
# misc.c
# expr.c
export PATH; PATH=/bin:$PATH
echo shar: extracting "'makefile'" '(1372 characters)'
if test -f 'makefile'
then
echo shar: will not over-write existing file "'makefile'"
else
sed 's/^ X//' << \SHAR_EOF > 'makefile'
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#
XCFLAGS = -O -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
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 <test.m4 >unxm4.out
X @echo "pd m4:"
X time ./m4 <test.m4 >pdm4.out
X @echo "un*x m4:"
X time ${MBIN}/m4 <test.m4 >unxm4.out
X @echo "pd m4:"
X time ./m4 <test.m4 >pdm4.out
X @echo "un*x m4:"
X time ${MBIN}/m4 <test.m4 >unxm4.out
X @echo "pd m4:"
X time ./m4 <test.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
Xpack:
X shar -a makefile ${INCL} ${CSRC} >M4MAIN.SHAR
X shar -a ${MSRC} ${DOCS} >M4MSRC.SHAR
SHAR_EOF
if test 1372 -ne "`wc -c < 'makefile'`"
then
echo shar: error transmitting "'makefile'" '(should have been 1372 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'mdef.h'" '(4711 characters)'
if test -f 'mdef.h'
then
echo shar: will not over-write existing file "'mdef.h'"
else
sed 's/^ X//' << \SHAR_EOF > 'mdef.h'
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 <stdio.h>
X#include <ctype.h>
X#include <signal.h>
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)
SHAR_EOF
if test 4711 -ne "`wc -c < 'mdef.h'`"
then
echo shar: error transmitting "'mdef.h'" '(should have been 4711 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'extr.h'" '(1136 characters)'
if test -f 'extr.h'
then
echo shar: will not over-write existing file "'extr.h'"
else
sed 's/^ X//' << \SHAR_EOF > '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 */
SHAR_EOF
if test 1136 -ne "`wc -c < 'extr.h'`"
then
echo shar: error transmitting "'extr.h'" '(should have been 1136 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'main.c'"
if test -f 'main.c'
then
echo shar: will not over-write existing file "'main.c'"
else
cat << \SHAR_EOF > 'main.c'
/*
* main.c
* Facility: m4 macro processor
* by: oz
*/
#include "mdef.h"
/*
* m4 - macro processor
*
* PD m4 is based on the macro tool distributed with the software
* tools (VOS) package, and described in the "SOFTWARE TOOLS" and
* "SOFTWARE TOOLS IN PASCAL" books. It has been expanded to include
* most of the command set of SysV m4, the standard UN*X macro processor.
*
* Since both PD m4 and UN*X m4 are based on SOFTWARE TOOLS macro,
* there may be certain implementation similarities between
* the two. The PD m4 was produced without ANY references to m4
* sources.
*
* References:
*
* Software Tools distribution: macro
*
* Kernighan, Brian W. and P. J. Plauger, SOFTWARE
* TOOLS IN PASCAL, Addison-Wesley, Mass. 1981
*
* Kernighan, Brian W. and P. J. Plauger, SOFTWARE
* TOOLS, Addison-Wesley, Mass. 1976
*
* Kernighan, Brian W. and Dennis M. Ritchie,
* THE M4 MACRO PROCESSOR, Unix Programmer's Manual,
* Seventh Edition, Vol. 2, Bell Telephone Labs, 1979
*
* System V man page for M4
*
* Modification History:
*
* Jan 28 1986 Oz Break the whole thing into little
* pieces, for easier (?) maintenance.
*
* Dec 12 1985 Oz Optimize the code, try to squeeze
* few microseconds out..
*
* Dec 05 1985 Oz Add getopt interface, define (-D),
* undefine (-U) options.
*
* Oct 21 1985 Oz Clean up various bugs, add comment handling.
*
* June 7 1985 Oz Add some of SysV m4 stuff (m4wrap, pushdef,
* popdef, decr, shift etc.).
*
* June 5 1985 Oz Initial cut.
*
* Implementation Notes:
*
* [1] PD m4 uses a different (and simpler) stack mechanism than the one
* described in Software Tools and Software Tools in Pascal books.
* The triple stack nonsense is replaced with a single stack containing
* the call frames and the arguments. Each frame is back-linked to a
* previous stack frame, which enables us to rewind the stack after
* each nested call is completed. Each argument is a character pointer
* to the beginning of the argument string within the string space.
* The only exceptions to this are (*) arg 0 and arg 1, which are
* the macro definition and macro name strings, stored dynamically
* for the hash table.
*
* . .
* | . | <-- sp | . |
* +-------+ +-----+
* | arg 3 ------------------------------->| str |
* +-------+ | . |
* | arg 2 --------------+ .
* +-------+ |
* * | | |
* +-------+ | +-----+
* | plev | <-- fp +---------------->| str |
* +-------+ | . |
* | type | .
* +-------+
* | prcf -----------+ plev: paren level
* +-------+ | type: call type
* | . | | prcf: prev. call frame
* . |
* +-------+ |
* | <----------+
* +-------+
*
* [2] We have three types of null values:
*
* nil - nodeblock pointer type 0
* null - null string ("")
* NULL - Stdio-defined NULL
*
*/
ndptr hashtab[HASHSIZE]; /* hash table for macros etc. */
char buf[BUFSIZE]; /* push-back buffer */
char *bp = buf; /* first available character */
char *endpbb = buf+BUFSIZE; /* end of push-back buffer */
stae mstack[STACKMAX+1]; /* stack of m4 machine */
char strspace[STRSPMAX+1]; /* string space for evaluation */
char *ep = strspace; /* first free char in strspace */
char *endest= strspace+STRSPMAX;/* end of string space */
int sp; /* current m4 stack pointer */
int fp; /* m4 call frame pointer */
FILE *infile[MAXINP]; /* input file stack (0=stdin) */
FILE *outfile[MAXOUT]; /* diversion array(0=bitbucket)*/
FILE *active; /* active output file pointer */
char *m4temp; /* filename for diversions */
int ilevel = 0; /* input file stack pointer */
int oindex = 0; /* diversion index.. */
char *null = ""; /* as it says.. just a null.. */
char *m4wraps = ""; /* m4wrap string default.. */
char lquote = LQUOTE; /* left quote character (`) */
char rquote = RQUOTE; /* right quote character (') */
char scommt = SCOMMT; /* start character for comment */
char ecommt = ECOMMT; /* end character for comment */
struct keyblk keywrds[] = { /* m4 keywords to be installed */
"include", INCLTYPE,
"sinclude", SINCTYPE,
"define", DEFITYPE,
"defn", DEFNTYPE,
"divert", DIVRTYPE,
"expr", EXPRTYPE,
"eval", EXPRTYPE,
"substr", SUBSTYPE,
"ifelse", IFELTYPE,
"ifdef", IFDFTYPE,
"len", LENGTYPE,
"incr", INCRTYPE,
"decr", DECRTYPE,
"dnl", DNLNTYPE,
"changequote", CHNQTYPE,
"changecom", CHNCTYPE,
"index", INDXTYPE,
#ifdef EXTENDED
"paste", PASTTYPE,
"spaste", SPASTYPE,
#endif
"popdef", POPDTYPE,
"pushdef", PUSDTYPE,
"dumpdef", DUMPTYPE,
"shift", SHIFTYPE,
"translit", TRNLTYPE,
"undefine", UNDFTYPE,
"undivert", UNDVTYPE,
"divnum", DIVNTYPE,
"maketemp", MKTMTYPE,
"errprint", ERRPTYPE,
"m4wrap", M4WRTYPE,
"m4exit", EXITTYPE,
#if unix || vms
"syscmd", SYSCTYPE,
"sysval", SYSVTYPE,
#endif
#if unix
"unix", MACRTYPE,
#else
#if vms
"vms", MACRTYPE,
#endif
#endif
};
#define MAXKEYS (sizeof(keywrds)/sizeof(struct keyblk))
extern ndptr lookup();
extern ndptr addent();
extern int onintr();
extern char *malloc();
extern char *mktemp();
extern int optind;
extern char *optarg;
main(argc,argv)
char *argv[];
{
register int c;
register int n;
char *p;
if (signal(SIGINT, SIG_IGN) != SIG_IGN)
signal(SIGINT, onintr);
#ifdef NONZEROPAGES
initm4();
#endif
initkwds();
while ((c = getopt(argc, argv, "tD:U:o:")) != EOF)
switch(c) {
case 'D': /* define something..*/
for (p = optarg; *p; p++)
if (*p == '=')
break;
if (*p)
*p++ = EOS;
dodefine(optarg, p);
break;
case 'U': /* undefine... */
remhash(optarg, TOP);
break;
case 'o': /* specific output */
case '?':
default:
usage();
}
infile[0] = stdin; /* default input (naturally) */
active = stdout; /* default active output */
m4temp = mktemp(DIVNAM); /* filename for diversions */
sp = -1; /* stack pointer initialized */
fp = 0; /* frame pointer initialized */
macro(); /* get some work done here */
if (*m4wraps) { /* anything for rundown ?? */
ilevel = 0; /* in case m4wrap includes.. */
putback(EOF); /* eof is a must !! */
pbstr(m4wraps); /* user-defined wrapup act */
macro(); /* last will and testament */
}
else /* default wrap-up: undivert */
for (n = 1; n < MAXOUT; n++)
if (outfile[n] != NULL)
getdiv(n);
/* remove bitbucket if used */
if (outfile[0] != NULL) {
(void) fclose(outfile[0]);
m4temp[UNIQUE] = '0';
#if vms
(void) remove(m4temp);
#else
(void) unlink(m4temp);
#endif
}
exit(0);
}
ndptr inspect(); /* forward ... */
/*
* macro - the work horse..
*
*/
macro() {
char token[MAXTOK];
register char *s;
register int t, l;
register ndptr p;
register int nlpar;
cycle {
if ((t = gpbc()) == '_' || isalpha(t)) {
putback(t);
if ((p = inspect(s = token)) == nil) {
if (sp < 0)
while (*s)
putc(*s++, active);
else
while (*s)
chrsave(*s++);
}
else {
/*
* real thing.. First build a call frame:
*
*/
pushf(fp); /* previous call frm */
pushf(p->type); /* type of the call */
pushf(0); /* parenthesis level */
fp = sp; /* new frame pointer */
/*
* now push the string arguments:
*
*/
pushs(p->defn); /* defn string */
pushs(p->name); /* macro name */
pushs(ep); /* start next..*/
putback(l = gpbc());
if (l != LPAREN) { /* add bracks */
putback(RPAREN);
putback(LPAREN);
}
}
}
else if (t == EOF) {
if (sp > -1)
error("m4: unexpected end of input");
if (--ilevel < 0)
break; /* all done thanks.. */
(void) fclose(infile[ilevel+1]);
continue;
}
/*
* non-alpha single-char token seen..
* [the order of else if .. stmts is
* important.]
*
*/
else if (t == lquote) { /* strip quotes */
nlpar = 1;
do {
if ((l = gpbc()) == rquote)
nlpar--;
else if (l == lquote)
nlpar++;
else if (l == EOF)
error("m4: missing right quote");
if (nlpar > 0)
chrsave(l);
}
while (nlpar != 0);
}
else if (sp < 0) { /* not in a macro at all */
if (t == scommt) { /* comment handling here */
putc(t, active);
while ((t = gpbc()) != ecommt)
putc(t, active);
}
putc(t, active); /* output directly.. */
}
else switch(t) {
case LPAREN:
if (PARLEV > 0)
chrsave(t);
while (isspace(l = gpbc()))
; /* skip blank, tab, nl.. */
putback(l);
PARLEV++;
break;
case RPAREN:
if (--PARLEV > 0)
chrsave(t);
else { /* end of argument list */
chrsave(EOS);
if (sp == STACKMAX)
error("m4: internal stack overflow");
if (CALTYP == MACRTYPE)
expand(mstack+fp+1, sp-fp);
else
eval(mstack+fp+1, sp-fp, CALTYP);
ep = PREVEP; /* flush strspace */
sp = PREVSP; /* previous sp.. */
fp = PREVFP; /* rewind stack...*/
}
break;
case COMMA:
if (PARLEV == 1) {
chrsave(EOS); /* new argument */
while (isspace(l = gpbc()))
;
putback(l);
pushs(ep);
}
break;
default:
chrsave(t); /* stack the char */
break;
}
}
}
/*
* build an input token..
* consider only those starting with _ or A-Za-z. This is a
* combo with lookup to speed things up.
*/
ndptr
inspect(tp)
register char *tp;
{
register int h = 0;
register char c;
register char *name = tp;
register char *etp = tp+MAXTOK;
register ndptr p;
while (tp < etp && (isalnum(c = gpbc()) || c == '_'))
h += (*tp++ = c);
putback(c);
if (tp == etp)
error("m4: token too long");
*tp = EOS;
for (p = hashtab[h%HASHSIZE]; p != nil; p = p->nxtptr)
if (strcmp(name, p->name) == 0)
break;
return(p);
}
#ifdef NONZEROPAGES
/*
* initm4 - initialize various tables. Useful only if your system
* does not know anything about demand-zero pages.
*
*/
initm4()
{
register int i;
for (i = 0; i < HASHSIZE; i++)
hashtab[i] = nil;
for (i = 0; i < MAXOUT; i++)
outfile[i] = NULL;
}
#endif
/*
* initkwds - initialise m4 keywords as fast as possible.
* This very similar to install, but without certain overheads,
* such as calling lookup. Malloc is not used for storing the
* keyword strings, since we simply use the static pointers
* within keywrds block. We also assume that there is enough memory
* to at least install the keywords (i.e. malloc won't fail).
*
*/
initkwds() {
register int i;
register int h;
register ndptr p;
for (i = 0; i < MAXKEYS; i++) {
h = hash(keywrds[i].knam);
p = (ndptr) malloc(sizeof(struct ndblock));
p->nxtptr = hashtab[h];
hashtab[h] = p;
p->name = keywrds[i].knam;
p->defn = null;
p->type = keywrds[i].ktyp | STATIC;
}
}
SHAR_EOF
fi # end of overwriting check
echo shar: extracting "'eval.c'" '(5707 characters)'
if test -f 'eval.c'
then
echo shar: will not over-write existing file "'eval.c'"
else
sed 's/^ X//' << \SHAR_EOF > '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}
SHAR_EOF
if test 5707 -ne "`wc -c < 'eval.c'`"
then
echo shar: error transmitting "'eval.c'" '(should have been 5707 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'serv.c'" '(11554 characters)'
if test -f 'serv.c'
then
echo shar: will not over-write existing file "'serv.c'"
else
sed 's/^ X//' << \SHAR_EOF > 'serv.c'
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}
SHAR_EOF
if test 11554 -ne "`wc -c < 'serv.c'`"
then
echo shar: error transmitting "'serv.c'" '(should have been 11554 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'look.c'" '(1617 characters)'
if test -f 'look.c'
then
echo shar: will not over-write existing file "'look.c'"
else
sed 's/^ X//' << \SHAR_EOF > 'look.c'
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
SHAR_EOF
if test 1617 -ne "`wc -c < 'look.c'`"
then
echo shar: error transmitting "'look.c'" '(should have been 1617 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'misc.c'" '(5005 characters)'
if test -f 'misc.c'
then
echo shar: will not over-write existing file "'misc.c'"
else
sed 's/^ X//' << \SHAR_EOF > 'misc.c'
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 <stdio.h>
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
SHAR_EOF
if test 5005 -ne "`wc -c < 'misc.c'`"
then
echo shar: error transmitting "'misc.c'" '(should have been 5005 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'expr.c'" '(11531 characters)'
if test -f 'expr.c'
then
echo shar: will not over-write existing file "'expr.c'"
else
sed 's/^ X//' << \SHAR_EOF > '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}
SHAR_EOF
if test 11531 -ne "`wc -c < 'expr.c'`"
then
echo shar: error transmitting "'expr.c'" '(should have been 11531 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0
--
You see things, and you say "WHY?" Usenet: [decvax|ihnp4]!utzoo!yetti!oz
But I dream things that never were; ......!seismo!mnetor!yetti!oz
and say "WHY NOT?" Bitnet: oz@[yusol|yulibra|yuyetti]
[Back To Methuselah] Bernard Shaw Phonet: [416] 736-5257 x 3976
--
For comp.sources.unix stuff, mail to sou...@uunet.uu.net.