v13i038: Public domain M4 macro processor, Part01/02

Rich Salz rsalz at bbn.com
Sat Feb 13 08:11:12 AEST 1988


Submitted-by: Ozan Yigit <yetti!oz>
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 sources at uunet.uu.net.



More information about the Comp.sources.unix mailing list