[comp.os.minix] M4

oz@yunexus.UUCP (Ozan Yigit) (08/20/89)

This is a posting of my Public Domain M4, with the explicit purpose of
getting someone interested enough to port to Minix. It has been posted
before, to comp.sources.unix, but since nobody seems to have ported to
minix, It may be worthwhile to post again. I hope this is not a waste of
your bandwith. I figure: a un*x is not complete without this prehistoric,
but still useful macro-processor :-).

posting in two following articles.

enjoy..	oz
-- 
The king: If there's no meaning	   	    Usenet:    oz@nexus.yorku.ca
in it, that saves a world of trouble        ......!uunet!utai!yunexus!oz
you know, as we needn't try to find any.    Bitnet: oz@[yulibra|yuyetti]
Lewis Carroll (Alice in Worderland)         Phonet: +1 416 736-5257x3976

oz@yunexus.UUCP (Ozan Yigit) (08/20/89)

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  makefile mdef.h extr.h patchlevel.h main.c eval.c serv.c
#   look.c misc.c expr.c
# Wrapped by oz@yunexus on Sun Aug 20 01:09:43 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'makefile' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'makefile'\"
else
echo shar: Extracting \"'makefile'\" \(1432 characters\)
sed "s/^X//" >'makefile' <<'END_OF_FILE'
X#
X# pd m4	[oz]
X#
X#	-DEXTENDED 
X#		if you like to get paste & spaste macros.
X#	-DVOID 
X#		if your C compiler does NOT support void.
X#	-DGETOPT
X#		if you STILL do not have getopt	in your library.
X#		[This means your library is broken. Fix it.]
X#	-DDUFFCP
X#		if you do not have fast memcpy in your library.
X#
XCC = rcc
XCFLAGS = -O -lint -DEXTENDED
XDEST =  /usr/local/bin
XMANL = 	/usr/man/manl
XOBJS =  main.o eval.o serv.o look.o misc.o expr.o
XCSRC =  main.c eval.c serv.c look.c misc.c expr.c
XINCL =  mdef.h extr.h patchlevel.h
XMSRC =  ack.m4 hanoi.m4 hash.m4 sqroot.m4 string.m4 test.m4
XDOCS =	README MANIFEST m4.1
X
XMBIN = /usr/bin
X
Xm4: ${OBJS}
X	@echo "loading m4.."
X	@cc -s -o m4 ${OBJS}
X	@size m4
X
X${OBJS}: ${INCL} 
X
Xlint:
X	lint -h ${CSRC}
X
Xinstall: m4
X	install ./m4 ${DEST}/m4
X	cp ./m4.1 ${MANL}/m4.l
X
Xdeinstall: 
X	rm -f ${DEST}/m4
X	rm -f ${MANL}/m4.l
Xtime: m4
X	@echo "timing comparisons.."
X	@echo "un*x m4:"
X	time ${MBIN}/m4 <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 M4MAIN.SHAR M4MSRC.SHAR
Xpack:
X	shar  makefile ${INCL} ${CSRC} >M4MAIN.SHAR
X	shar ${MSRC} ${DOCS} patchlevel.h >M4MSRC.SHAR
END_OF_FILE
if test 1432 -ne `wc -c <'makefile'`; then
    echo shar: \"'makefile'\" unpacked with wrong size!
fi
# end of 'makefile'
fi
if test -f 'mdef.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'mdef.h'\"
else
echo shar: Extracting \"'mdef.h'\" \(4711 characters\)
sed "s/^X//" >'mdef.h' <<'END_OF_FILE'
X/*
X * mdef.h
X * Facility: m4 macro processor
X * by: oz
X */
X
X
X#ifndef unix
X#define unix 0
X#endif 
X
X#ifndef vms
X#define vms 0
X#endif
X
X#if vms
X
X#include stdio
X#include ctype
X#include signal
X
X#else 
X
X#include <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)
END_OF_FILE
if test 4711 -ne `wc -c <'mdef.h'`; then
    echo shar: \"'mdef.h'\" unpacked with wrong size!
fi
# end of 'mdef.h'
fi
if test -f 'extr.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'extr.h'\"
else
echo shar: Extracting \"'extr.h'\" \(1136 characters\)
sed "s/^X//" >'extr.h' <<'END_OF_FILE'
Xextern ndptr hashtab[];		/* hash table for macros etc.  */
Xextern char buf[];		/* push-back buffer	       */
Xextern char *bp;		/* first available character   */
Xextern char *endpbb;		/* end of push-back buffer     */
Xextern stae mstack[];		/* stack of m4 machine         */
Xextern char *ep;		/* first free char in strspace */
Xextern char *endest;		/* end of string space	       */
Xint sp; 			/* current m4  stack pointer   */
Xint fp; 			/* m4 call frame pointer       */
Xextern FILE *infile[];		/* input file stack (0=stdin)  */
Xextern FILE *outfile[];		/* diversion array(0=bitbucket)*/
Xextern FILE *active;		/* active output file pointer  */
Xextern char *m4temp;		/* filename for diversions     */
Xextern int ilevel;		/* input file stack pointer    */
Xextern int oindex;		/* diversion index..	       */
Xextern char *null;		/* as it says.. just a null..  */
Xextern char *m4wraps;		/* m4wrap string default..     */
Xextern char lquote;		/* left quote character  (`)   */
Xextern char rquote;		/* right quote character (')   */
Xextern char scommt;		/* start character for comment */
Xextern char ecommt;		/* end character for comment   */
END_OF_FILE
if test 1136 -ne `wc -c <'extr.h'`; then
    echo shar: \"'extr.h'\" unpacked with wrong size!
fi
# end of 'extr.h'
fi
if test -f 'patchlevel.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'patchlevel.h'\"
else
echo shar: Extracting \"'patchlevel.h'\" \(21 characters\)
sed "s/^X//" >'patchlevel.h' <<'END_OF_FILE'
X#define PATCHLEVEL 1
END_OF_FILE
if test 21 -ne `wc -c <'patchlevel.h'`; then
    echo shar: \"'patchlevel.h'\" unpacked with wrong size!
fi
# end of 'patchlevel.h'
fi
if test -f 'main.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'main.c'\"
else
echo shar: Extracting \"'main.c'\" \(11085 characters\)
sed "s/^X//" >'main.c' <<'END_OF_FILE'
X/*
X * main.c
X * Facility: m4 macro processor
X * by: oz
X */
X
X#include "mdef.h"
X
X/*
X * m4 - macro processor
X *
X * PD m4 is based on the macro tool distributed with the software 
X * tools (VOS) package, and described in the "SOFTWARE TOOLS" and 
X * "SOFTWARE TOOLS IN PASCAL" books. It has been expanded to include 
X * most of the command set of SysV m4, the standard UN*X macro processor.
X *
X * Since both PD m4 and UN*X m4 are based on SOFTWARE TOOLS macro,
X * there may be certain implementation similarities between
X * the two. The PD m4 was produced without ANY references to m4
X * sources.
X *
X * References:
X *
X *	Software Tools distribution: macro
X *
X *	Kernighan, Brian W. and P. J. Plauger, SOFTWARE
X *	TOOLS IN PASCAL, Addison-Wesley, Mass. 1981
X *
X *	Kernighan, Brian W. and P. J. Plauger, SOFTWARE
X *	TOOLS, Addison-Wesley, Mass. 1976
X *
X *	Kernighan, Brian W. and Dennis M. Ritchie,
X *	THE M4 MACRO PROCESSOR, Unix Programmer's Manual,
X *	Seventh Edition, Vol. 2, Bell Telephone Labs, 1979
X *
X *	System V man page for M4
X *
X * Modification History:
X *
X * Jan 28 1986 Oz	Break the whole thing into little
X *			pieces, for easier (?) maintenance.
X *
X * Dec 12 1985 Oz	Optimize the code, try to squeeze
X *			few microseconds out..
X *
X * Dec 05 1985 Oz	Add getopt interface, define (-D),
X *			undefine (-U) options.
X *
X * Oct 21 1985 Oz	Clean up various bugs, add comment handling.
X *
X * June 7 1985 Oz	Add some of SysV m4 stuff (m4wrap, pushdef,
X *			popdef, decr, shift etc.).
X *
X * June 5 1985 Oz	Initial cut.
X *
X * Implementation Notes:
X *
X * [1]	PD m4 uses a different (and simpler) stack mechanism than the one 
X *	described in Software Tools and Software Tools in Pascal books. 
X *	The triple stack nonsense is replaced with a single stack containing 
X *	the call frames and the arguments. Each frame is back-linked to a 
X * 	previous stack frame, which enables us to rewind the stack after 
X * 	each nested call is completed. Each argument is a character pointer 
X *	to the beginning of the argument string within the string space.
X *	The only exceptions to this are (*) arg 0 and arg 1, which are
X * 	the macro definition and macro name strings, stored dynamically
X *	for the hash table.
X *
X *	    .					   .
X *	|   .	|  <-- sp			|  .  |
X *	+-------+				+-----+
X *	| arg 3 ------------------------------->| str |
X *	+-------+				|  .  |
X *	| arg 2 --------------+ 		   .
X *	+-------+	      |
X *	    *		      |			|     |
X *	+-------+	      | 		+-----+
X *	| plev	|  <-- fp     +---------------->| str |
X *	+-------+				|  .  |
X *	| type	|				   .
X *	+-------+
X *	| prcf	-----------+		plev: paren level
X *	+-------+  	   |		type: call type
X *	|   .	| 	   |		prcf: prev. call frame
X *	    .	   	   |
X *	+-------+	   |
X *	|	<----------+
X *	+-------+
X *
X * [2]	We have three types of null values:
X *
X *		nil  - nodeblock pointer type 0
X *		null - null string ("")
X *		NULL - Stdio-defined NULL
X *
X */
X
Xndptr hashtab[HASHSIZE];	/* hash table for macros etc.  */
Xchar buf[BUFSIZE];		/* push-back buffer	       */
Xchar *bp = buf; 		/* first available character   */
Xchar *endpbb = buf+BUFSIZE;	/* end of push-back buffer     */
Xstae mstack[STACKMAX+1]; 	/* stack of m4 machine         */
Xchar strspace[STRSPMAX+1];	/* string space for evaluation */
Xchar *ep = strspace;		/* first free char in strspace */
Xchar *endest= strspace+STRSPMAX;/* end of string space	       */
Xint sp; 			/* current m4  stack pointer   */
Xint fp; 			/* m4 call frame pointer       */
XFILE *infile[MAXINP];		/* input file stack (0=stdin)  */
XFILE *outfile[MAXOUT];		/* diversion array(0=bitbucket)*/
XFILE *active;			/* active output file pointer  */
Xchar *m4temp;			/* filename for diversions     */
Xint ilevel = 0; 		/* input file stack pointer    */
Xint oindex = 0; 		/* diversion index..	       */
Xchar *null = "";                /* as it says.. just a null..  */
Xchar *m4wraps = "";             /* m4wrap string default..     */
Xchar lquote = LQUOTE;		/* left quote character  (`)   */
Xchar rquote = RQUOTE;		/* right quote character (')   */
Xchar scommt = SCOMMT;		/* start character for comment */
Xchar ecommt = ECOMMT;		/* end character for comment   */
Xstruct keyblk keywrds[] = {	/* m4 keywords to be installed */
X	"include",      INCLTYPE,
X	"sinclude",     SINCTYPE,
X	"define",       DEFITYPE,
X	"defn",         DEFNTYPE,
X	"divert",       DIVRTYPE,
X	"expr",         EXPRTYPE,
X	"eval",         EXPRTYPE,
X	"substr",       SUBSTYPE,
X	"ifelse",       IFELTYPE,
X	"ifdef",        IFDFTYPE,
X	"len",          LENGTYPE,
X	"incr",         INCRTYPE,
X	"decr",         DECRTYPE,
X	"dnl",          DNLNTYPE,
X	"changequote",  CHNQTYPE,
X	"changecom",    CHNCTYPE,
X	"index",        INDXTYPE,
X#ifdef EXTENDED
X	"paste",        PASTTYPE,
X	"spaste",       SPASTYPE,
X#endif
X	"popdef",       POPDTYPE,
X	"pushdef",      PUSDTYPE,
X	"dumpdef",      DUMPTYPE,
X	"shift",        SHIFTYPE,
X	"translit",     TRNLTYPE,
X	"undefine",     UNDFTYPE,
X	"undivert",     UNDVTYPE,
X	"divnum",       DIVNTYPE,
X	"maketemp",     MKTMTYPE,
X	"errprint",     ERRPTYPE,
X	"m4wrap",       M4WRTYPE,
X	"m4exit",       EXITTYPE,
X#if unix || vms
X	"syscmd",       SYSCTYPE,
X	"sysval",       SYSVTYPE,
X#endif
X#if unix
X	"unix",         MACRTYPE,
X#else
X#if vms
X	"vms",          MACRTYPE,
X#endif
X#endif
X};
X
X#define MAXKEYS	(sizeof(keywrds)/sizeof(struct keyblk))
X
Xextern ndptr lookup();
Xextern ndptr addent();
Xextern int onintr();
X
Xextern char *malloc();
Xextern char *mktemp();
X
Xextern int optind;
Xextern char *optarg;
X
Xmain(argc,argv)
Xchar *argv[];
X{
X	register int c;
X	register int n;
X	char *p;
X
X	if (signal(SIGINT, SIG_IGN) != SIG_IGN)
X		signal(SIGINT, onintr);
X#ifdef NONZEROPAGES
X	initm4();
X#endif
X	initkwds();
X
X	while ((c = getopt(argc, argv, "tD:U:o:")) != EOF)
X		switch(c) {
X
X		case 'D':               /* define something..*/
X			for (p = optarg; *p; p++)
X				if (*p == '=')
X					break;
X			if (*p)
X				*p++ = EOS;
X			dodefine(optarg, p);
X			break;
X		case 'U':               /* undefine...       */
X			remhash(optarg, TOP);
X			break;
X		case 'o':		/* specific output   */
X		case '?':
X		default:
X			usage();
X		}
X
X	infile[0] = stdin;		/* default input (naturally) */
X	active = stdout;		/* default active output     */
X	m4temp = mktemp(DIVNAM);	/* filename for diversions   */
X
X	sp = -1;			/* stack pointer initialized */
X	fp = 0; 			/* frame pointer initialized */
X
X	macro();			/* get some work done here   */
X
X	if (*m4wraps) { 		/* anything for rundown ??   */
X		ilevel = 0;		/* in case m4wrap includes.. */
X		putback(EOF);		/* eof is a must !!	     */
X		pbstr(m4wraps); 	/* user-defined wrapup act   */
X		macro();		/* last will and testament   */
X	}
X	else				/* default wrap-up: undivert */
X		for (n = 1; n < MAXOUT; n++)
X			if (outfile[n] != NULL)
X				getdiv(n);
X
X					/* remove bitbucket if used  */
X	if (outfile[0] != NULL) {
X		(void) fclose(outfile[0]);
X		m4temp[UNIQUE] = '0';
X#if vms
X		(void) remove(m4temp);
X#else
X		(void) unlink(m4temp);
X#endif
X	}
X
X	exit(0);
X}
X
Xndptr inspect();	/* forward ... */
X
X/*
X * macro - the work horse..
X *
X */
Xmacro() {
X	char token[MAXTOK];
X	register char *s;
X	register int t, l;
X	register ndptr p;
X	register int  nlpar;
X
X	cycle {
X		if ((t = gpbc()) == '_' || isalpha(t)) {
X			putback(t);
X			if ((p = inspect(s = token)) == nil) {
X				if (sp < 0)
X					while (*s)
X						putc(*s++, active);
X				else
X					while (*s)
X						chrsave(*s++);
X			}
X			else {
X		/*
X		 * real thing.. First build a call frame:
X		 *
X		 */
X				pushf(fp);	/* previous call frm */
X				pushf(p->type); /* type of the call  */
X				pushf(0);	/* parenthesis level */
X				fp = sp;	/* new frame pointer */
X		/*
X		 * now push the string arguments:
X		 *
X		 */
X				pushs(p->defn);	      /* defn string */
X				pushs(p->name);	      /* macro name  */
X				pushs(ep);	      /* start next..*/
X
X				putback(l = gpbc());
X				if (l != LPAREN)  {   /* add bracks  */
X					putback(RPAREN);
X					putback(LPAREN);
X				}
X			}
X		}
X		else if (t == EOF) {
X			if (sp > -1)
X				error("m4: unexpected end of input");
X			if (--ilevel < 0)
X				break;			/* all done thanks.. */
X			(void) fclose(infile[ilevel+1]);
X			continue;
X		}
X	/*
X	 * non-alpha single-char token seen..
X	 * [the order of else if .. stmts is
X	 * important.]
X	 *
X	 */
X		else if (t == lquote) { 		/* strip quotes */
X			nlpar = 1;
X			do {
X				if ((l = gpbc()) == rquote)
X					nlpar--;
X				else if (l == lquote)
X					nlpar++;
X				else if (l == EOF)
X					error("m4: missing right quote");
X				if (nlpar > 0) {
X					if (sp < 0)
X						putc(l, active);
X					else
X						chrsave(l);
X				}
X			}
X			while (nlpar != 0);
X		}
X
X		else if (sp < 0) {		/* not in a macro at all */
X			if (t == scommt) {	/* comment handling here */
X				putc(t, active);
X				while ((t = gpbc()) != ecommt)
X					putc(t, active);
X			}
X			putc(t, active);	/* output directly..	 */
X		}
X
X		else switch(t) {
X
X		case LPAREN:
X			if (PARLEV > 0)
X				chrsave(t);
X			while (isspace(l = gpbc()))
X				;		/* skip blank, tab, nl.. */
X			putback(l);
X			PARLEV++;
X			break;
X
X		case RPAREN:
X			if (--PARLEV > 0)
X				chrsave(t);
X			else {			/* end of argument list */
X				chrsave(EOS);
X
X				if (sp == STACKMAX)
X					error("m4: internal stack overflow");
X
X				if (CALTYP == MACRTYPE)
X					expand(mstack+fp+1, sp-fp);
X				else
X					eval(mstack+fp+1, sp-fp, CALTYP);
X
X				ep = PREVEP;	/* flush strspace */
X				sp = PREVSP;	/* previous sp..  */
X				fp = PREVFP;	/* rewind stack...*/
X			}
X			break;
X
X		case COMMA:
X			if (PARLEV == 1)	{
X				chrsave(EOS);		/* new argument   */
X				while (isspace(l = gpbc()))
X					;
X				putback(l);
X				pushs(ep);
X			}
X			break;
X		default:
X			chrsave(t);			/* stack the char */
X			break;
X		}
X	}
X}
X
X
X/*
X * build an input token..
X * consider only those starting with _ or A-Za-z. This is a
X * combo with lookup to speed things up.
X */
Xndptr
Xinspect(tp) 
Xregister char *tp;
X{
X	register int h = 0;
X	register char c;
X	register char *name = tp;
X	register char *etp = tp+MAXTOK;
X	register ndptr p;
X
X	while (tp < etp && (isalnum(c = gpbc()) || c == '_'))
X		h += (*tp++ = c);
X	putback(c);
X	if (tp == etp)
X		error("m4: token too long");
X	*tp = EOS;
X	for (p = hashtab[h%HASHSIZE]; p != nil; p = p->nxtptr)
X		if (strcmp(name, p->name) == 0)
X			break;
X	return(p);
X}
X
X#ifdef NONZEROPAGES
X/*
X * initm4 - initialize various tables. Useful only if your system 
X * does not know anything about demand-zero pages.
X *
X */
Xinitm4()
X{
X	register int i;
X
X	for (i = 0; i < HASHSIZE; i++)
X		hashtab[i] = nil;
X	for (i = 0; i < MAXOUT; i++)
X		outfile[i] = NULL;
X}
X#endif
X
X/*
X * initkwds - initialise m4 keywords as fast as possible. 
X * This very similar to install, but without certain overheads,
X * such as calling lookup. Malloc is not used for storing the 
X * keyword strings, since we simply use the static  pointers
X * within keywrds block. We also assume that there is enough memory 
X * to at least install the keywords (i.e. malloc won't fail).
X *
X */
Xinitkwds() {
X	register int i;
X	register int h;
X	register ndptr p;
X
X	for (i = 0; i < MAXKEYS; i++) {
X		h = hash(keywrds[i].knam);
X		p = (ndptr) malloc(sizeof(struct ndblock));
X		p->nxtptr = hashtab[h];
X		hashtab[h] = p;
X		p->name = keywrds[i].knam;
X		p->defn = null;
X		p->type = keywrds[i].ktyp | STATIC;
X	}
X}
END_OF_FILE
if test 11085 -ne `wc -c <'main.c'`; then
    echo shar: \"'main.c'\" unpacked with wrong size!
fi
# end of 'main.c'
fi
if test -f 'eval.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'eval.c'\"
else
echo shar: Extracting \"'eval.c'\" \(5707 characters\)
sed "s/^X//" >'eval.c' <<'END_OF_FILE'
X/*
X * eval.c
X * Facility: m4 macro processor
X * by: oz
X */
X
X#include "mdef.h"
X#include "extr.h"
X
Xextern ndptr lookup();
Xextern char *strsave();
Xextern char *mktemp();
X
X/*
X * eval - evaluate built-in macros.
X *	  argc - number of elements in argv.
X *	  argv - element vector :
X *			argv[0] = definition of a user
X *				  macro or nil if built-in.
X *			argv[1] = name of the macro or
X *				  built-in.
X *			argv[2] = parameters to user-defined
X *			   .	  macro or built-in.
X *			   .
X *
X * Note that the minimum value for argc is 3. A call in the form
X * of macro-or-builtin() will result in:
X *			argv[0] = nullstr
X *			argv[1] = macro-or-builtin
X *			argv[2] = nullstr
X *
X */
X
Xeval (argv, argc, td)
Xregister char *argv[];
Xregister int argc;
Xregister int  td;
X{
X	register int c, n;
X	static int sysval;
X
X#ifdef DEBUG
X	printf("argc = %d\n", argc);
X	for (n = 0; n < argc; n++)
X		printf("argv[%d] = %s\n", n, argv[n]);
X#endif
X	/*
X	 * if argc == 3 and argv[2] is null,
X	 * then we have macro-or-builtin() type call.
X	 * We adjust argc to avoid further checking..
X	 *
X	 */
X	if (argc == 3 && !*(argv[2]))
X		argc--;
X
X	switch (td & ~STATIC) {
X
X	case DEFITYPE:
X		if (argc > 2)
X			dodefine(argv[2], (argc > 3) ? argv[3] : null);
X		break;
X
X	case PUSDTYPE:
X		if (argc > 2)
X			dopushdef(argv[2], (argc > 3) ? argv[3] : null);
X		break;
X
X	case DUMPTYPE:
X		dodump(argv, argc);
X		break;
X
X	case EXPRTYPE:
X		/*
X		 * doexpr - evaluate arithmetic expression
X		 *
X		 */
X		if (argc > 2)
X			pbnum(expr(argv[2]));
X		break;
X
X	case IFELTYPE:
X		if (argc > 4)
X			doifelse(argv, argc);
X		break;
X
X	case IFDFTYPE:
X		/*
X		 * doifdef - select one of two alternatives based
X		 *	     on the existence of another definition
X		 */
X		if (argc > 3) {
X			if (lookup(argv[2]) != nil)
X				pbstr(argv[3]);
X			else if (argc > 4)
X				pbstr(argv[4]);
X		}
X		break;
X
X	case LENGTYPE:
X		/*
X		 * dolen - find the length of the argument
X		 *
X		 */
X		if (argc > 2)
X			pbnum((argc > 2) ? strlen(argv[2]) : 0);
X		break;
X
X	case INCRTYPE:
X		/*
X		 * doincr - increment the value of the argument
X		 *
X		 */
X		if (argc > 2)
X			pbnum(atoi(argv[2]) + 1);
X		break;
X
X	case DECRTYPE:
X		/*
X		 * dodecr - decrement the value of the argument
X		 *
X		 */
X		if (argc > 2)
X			pbnum(atoi(argv[2]) - 1);
X		break;
X
X#if unix || vms
X
X	case SYSCTYPE:
X		/*
X		 * dosys - execute system command
X		 *
X		 */
X		if (argc > 2)
X			sysval = system(argv[2]);
X		break;
X
X	case SYSVTYPE:
X		/*
X		 * dosysval - return value of the last system call.
X		 *
X		 */
X		pbnum(sysval);
X		break;
X#endif
X
X	case INCLTYPE:
X		if (argc > 2)
X			if (!doincl(argv[2])) {
X				fprintf(stderr,"m4: %s: ",argv[2]);
X				error("cannot open for read.");
X			}
X		break;
X
X	case SINCTYPE:
X		if (argc > 2)
X			(void) doincl(argv[2]);
X		break;
X#ifdef EXTENDED
X	case PASTTYPE:
X		if (argc > 2)
X			if (!dopaste(argv[2])) {
X				fprintf(stderr,"m4: %s: ",argv[2]);
X				error("cannot open for read.");
X			}
X		break;
X
X	case SPASTYPE:
X		if (argc > 2)
X			(void) dopaste(argv[2]);
X		break;
X#endif
X	case CHNQTYPE:
X		dochq(argv, argc);
X		break;
X
X	case CHNCTYPE:
X		dochc(argv, argc);
X		break;
X
X	case SUBSTYPE:
X		/*
X		 * dosub - select substring
X		 *
X		 */
X		if (argc > 3)
X			dosub(argv,argc);
X		break;
X
X	case SHIFTYPE:
X		/*
X		 * doshift - push back all arguments except the
X		 *	     first one (i.e. skip argv[2])
X		 */
X		if (argc > 3) {
X			for (n = argc-1; n > 3; n--) {
X				putback(rquote);
X				pbstr(argv[n]);
X				putback(lquote);
X				putback(',');
X			}
X			putback(rquote);
X			pbstr(argv[3]);
X			putback(lquote);
X		}
X		break;
X
X	case DIVRTYPE:
X		if (argc > 2 && (n = atoi(argv[2])) != 0)
X			dodiv(n);
X		else {
X			active = stdout;
X			oindex = 0;
X		}
X		break;
X
X	case UNDVTYPE:
X		doundiv(argv, argc);
X		break;
X
X	case DIVNTYPE:
X		/*
X		 * dodivnum - return the number of current
X		 * output diversion
X		 *
X		 */
X		pbnum(oindex);
X		break;
X
X	case UNDFTYPE:
X		/*
X		 * doundefine - undefine a previously defined
X		 *		macro(s) or m4 keyword(s).
X		 */
X		if (argc > 2)
X			for (n = 2; n < argc; n++)
X				remhash(argv[n], ALL);
X		break;
X
X	case POPDTYPE:
X		/*
X		 * dopopdef - remove the topmost definitions of
X		 *	      macro(s) or m4 keyword(s).
X		 */
X		if (argc > 2)
X			for (n = 2; n < argc; n++)
X				remhash(argv[n], TOP);
X		break;
X
X	case MKTMTYPE:
X		/*
X		 * dotemp - create a temporary file
X		 *
X		 */
X		if (argc > 2)
X			pbstr(mktemp(argv[2]));
X		break;
X
X	case TRNLTYPE:
X		/*
X		 * dotranslit - replace all characters in the
X		 *		source string that appears in
X		 *		the "from" string with the corresponding
X		 *		characters in the "to" string.
X		 *
X		 */
X		if (argc > 3) {
X			char temp[MAXTOK];
X			if (argc > 4)
X				map(temp, argv[2], argv[3], argv[4]);
X			else
X				map(temp, argv[2], argv[3], null);
X			pbstr(temp);
X		}
X		else
X		    if (argc > 2)
X			pbstr(argv[2]);
X		break;
X
X	case INDXTYPE:
X		/*
X		 * doindex - find the index of the second argument
X		 *	     string in the first argument string.
X		 *	     -1 if not present.
X		 */
X		pbnum((argc > 3) ? indx(argv[2], argv[3]) : -1);
X		break;
X
X	case ERRPTYPE:
X		/*
X		 * doerrp - print the arguments to stderr file
X		 *
X		 */
X		if (argc > 2) {
X			for (n = 2; n < argc; n++)
X				fprintf(stderr,"%s ", argv[n]);
X			fprintf(stderr, "\n");
X		}
X		break;
X
X	case DNLNTYPE:
X		/*
X		 * dodnl - eat-up-to and including newline
X		 *
X		 */
X		while ((c = gpbc()) != '\n' && c != EOF)
X			;
X		break;
X
X	case M4WRTYPE:
X		/*
X		 * dom4wrap - set up for wrap-up/wind-down activity
X		 *
X		 */
X		m4wraps = (argc > 2) ? strsave(argv[2]) : null;
X		break;
X
X	case EXITTYPE:
X		/*
X		 * doexit - immediate exit from m4.
X		 *
X		 */
X		exit((argc > 2) ? atoi(argv[2]) : 0);
X		break;
X
X	case DEFNTYPE:
X		if (argc > 2)
X			for (n = 2; n < argc; n++)
X				dodefn(argv[n]);
X		break;
X
X	default:
X		error("m4: major botch in eval.");
X		break;
X	}
X}
END_OF_FILE
if test 5707 -ne `wc -c <'eval.c'`; then
    echo shar: \"'eval.c'\" unpacked with wrong size!
fi
# end of 'eval.c'
fi
if test -f 'serv.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'serv.c'\"
else
echo shar: Extracting \"'serv.c'\" \(11554 characters\)
sed "s/^X//" >'serv.c' <<'END_OF_FILE'
X/*
X * serv.c
X * Facility: m4 macro processor
X * by: oz
X */
X 
X#include "mdef.h"
X#include "extr.h" 
X
Xextern ndptr lookup();
Xextern ndptr addent();
Xextern char  *strsave();
X 
Xchar *dumpfmt = "`%s'\t`%s'\n"; /* format string for dumpdef   */
X 
X/*
X * expand - user-defined macro expansion
X *
X */
Xexpand(argv, argc)
Xregister char *argv[];
Xregister int argc;
X{
X        register char *t;
X        register char *p;
X        register int  n;
X        register int  argno;
X 
X        t = argv[0];    /* defn string as a whole */
X        p = t;
X        while (*p)
X                p++;
X        p--;            /* last character of defn */
X        while (p > t) {
X                if (*(p-1) != ARGFLAG)
X                        putback(*p);
X                else {
X                        switch (*p) {
X 
X                        case '#':
X                                pbnum(argc-2);
X                                break;
X                        case '0':
X                        case '1':
X                        case '2':
X                        case '3':
X                        case '4':
X                        case '5':
X                        case '6':
X                        case '7':
X                        case '8':
X                        case '9':
X                                if ((argno = *p - '0') < argc-1)
X                                        pbstr(argv[argno+1]);
X                                break;
X                        case '*':
X                                for (n = argc - 1; n > 2; n--) {
X                                        pbstr(argv[n]);
X                                        putback(',');
X                                }
X                                pbstr(argv[2]);
X                                break;
X                        default :
X                                putback(*p);
X                                break;
X                        }
X                        p--;
X                }
X                p--;
X        }
X        if (p == t)         /* do last character */
X                putback(*p);
X}
X 
X/*
X * dodefine - install definition in the table
X *
X */
Xdodefine(name, defn)
Xregister char *name;
Xregister char *defn;
X{
X        register ndptr p;
X 
X        if (!*name)
X                error("m4: null definition.");
X        if (strcmp(name, defn) == 0)
X                error("m4: recursive definition.");
X        if ((p = lookup(name)) == nil)
X                p = addent(name);
X        else if (p->defn != null)
X                free(p->defn);
X        if (!*defn)
X                p->defn = null;
X        else
X                p->defn = strsave(defn);
X        p->type = MACRTYPE;
X}
X 
X/*
X * dodefn - push back a quoted definition of
X *      the given name.
X */
X 
Xdodefn(name)
Xchar *name;
X{
X        register ndptr p;
X 
X        if ((p = lookup(name)) != nil && p->defn != null) {
X                putback(rquote);
X                pbstr(p->defn);
X                putback(lquote);
X        }
X}
X     
X/*
X * dopushdef - install a definition in the hash table
X *      without removing a previous definition. Since
X *      each new entry is entered in *front* of the
X *      hash bucket, it hides a previous definition from
X *      lookup.
X */
Xdopushdef(name, defn)
Xregister char *name;
Xregister char *defn;
X{
X        register ndptr p;
X 
X        if (!*name)
X                error("m4: null definition");
X        if (strcmp(name, defn) == 0)
X                error("m4: recursive definition.");
X        p = addent(name);
X        if (!*defn)
X                p->defn = null;
X        else
X                p->defn = strsave(defn);
X        p->type = MACRTYPE;
X}
X 
X/*
X * dodumpdef - dump the specified definitions in the hash
X *      table to stderr. If nothing is specified, the entire
X *      hash table is dumped.
X *
X */
Xdodump(argv, argc)
Xregister char *argv[];
Xregister int argc;
X{
X        register int n;
X        ndptr p;
X 
X        if (argc > 2) {
X                for (n = 2; n < argc; n++)
X                        if ((p = lookup(argv[n])) != nil)
X                                fprintf(stderr, dumpfmt, p->name,
X                                p->defn);
X        }
X        else {
X                for (n = 0; n < HASHSIZE; n++)
X                        for (p = hashtab[n]; p != nil; p = p->nxtptr)
X                                fprintf(stderr, dumpfmt, p->name,
X                                p->defn);
X        }
X}
X 
X/*
X * doifelse - select one of two alternatives - loop.
X *
X */
Xdoifelse(argv,argc)
Xregister char *argv[];
Xregister int argc;
X{
X        cycle {
X                if (strcmp(argv[2], argv[3]) == 0)
X                        pbstr(argv[4]);
X                else if (argc == 6)
X                        pbstr(argv[5]);
X                else if (argc > 6) {
X                        argv += 3;
X                        argc -= 3;
X                        continue;
X                }
X                break;
X        }
X}
X 
X/*
X * doinclude - include a given file.
X *
X */
Xdoincl(ifile)
Xchar *ifile;
X{
X        if (ilevel+1 == MAXINP)
X                error("m4: too many include files.");
X        if ((infile[ilevel+1] = fopen(ifile, "r")) != NULL) {
X                ilevel++;
X                return (1);
X        }
X        else
X                return (0);
X}
X 
X#ifdef EXTENDED
X/*
X * dopaste - include a given file without any
X *           macro processing.
X */
Xdopaste(pfile)
Xchar *pfile;
X{
X        FILE *pf;
X        register int c;
X 
X        if ((pf = fopen(pfile, "r")) != NULL) {
X                while((c = getc(pf)) != EOF)
X                        putc(c, active);
X                (void) fclose(pf);
X                return(1);
X        }
X        else
X                return(0);
X}
X#endif
X 
X/*
X * dochq - change quote characters
X *
X */
Xdochq(argv, argc)
Xregister char *argv[];
Xregister int argc;
X{
X        if (argc > 2) {
X                if (*argv[2])
X                        lquote = *argv[2];
X                if (argc > 3) {
X                        if (*argv[3])
X                                rquote = *argv[3];
X                }
X                else
X                        rquote = lquote;
X        }
X        else {
X                lquote = LQUOTE;
X                rquote = RQUOTE;
X        }
X}
X 
X/*
X * dochc - change comment characters
X *
X */
Xdochc(argv, argc)
Xregister char *argv[];
Xregister int argc;
X{
X        if (argc > 2) {
X                if (*argv[2])
X                        scommt = *argv[2];
X                if (argc > 3) {
X                        if (*argv[3])
X                                ecommt = *argv[3];
X                }
X                else
X                        ecommt = ECOMMT;
X        }
X        else {
X                scommt = SCOMMT;
X                ecommt = ECOMMT;
X        }
X}
X 
X/*
X * dodivert - divert the output to a temporary file
X *
X */
Xdodiv(n)
Xregister int n;
X{
X        if (n < 0 || n >= MAXOUT)
X                n = 0;                  /* bitbucket */
X        if (outfile[n] == NULL) {
X                m4temp[UNIQUE] = n + '0';
X                if ((outfile[n] = fopen(m4temp, "w")) == NULL)
X                        error("m4: cannot divert.");
X        }
X        oindex = n;
X        active = outfile[n];
X}
X 
X/*
X * doundivert - undivert a specified output, or all
X *              other outputs, in numerical order.
X */
Xdoundiv(argv, argc)
Xregister char *argv[];
Xregister int argc;
X{
X        register int ind;
X        register int n;
X 
X        if (argc > 2) {
X                for (ind = 2; ind < argc; ind++) {
X                        n = atoi(argv[ind]);
X                        if (n > 0 && n < MAXOUT && outfile[n] != NULL)
X                                getdiv(n);
X 
X                }
X        }
X        else
X                for (n = 1; n < MAXOUT; n++)
X                        if (outfile[n] != NULL)
X                                getdiv(n);
X}
X 
X/*
X * dosub - select substring
X *
X */
Xdosub (argv, argc)
Xregister char *argv[];
Xregister int  argc;
X{
X        register char *ap, *fc, *k;
X        register int nc;
X 
X        if (argc < 5)
X                nc = MAXTOK;
X        else
X#ifdef EXPR
X                nc = expr(argv[4]);
X#else
X		nc = atoi(argv[4]);
X#endif
X        ap = argv[2];                   /* target string */
X#ifdef EXPR
X        fc = ap + expr(argv[3]);        /* first char */
X#else
X        fc = ap + atoi(argv[3]);        /* first char */
X#endif
X        if (fc >= ap && fc < ap+strlen(ap))
X                for (k = fc+min(nc,strlen(fc))-1; k >= fc; k--)
X                        putback(*k);
X}
X 
X/*
X * map:
X * map every character of s1 that is specified in from
X * into s3 and replace in s. (source s1 remains untouched)
X *
X * This is a standard implementation of map(s,from,to) function of ICON 
X * language. Within mapvec, we replace every character of "from" with 
X * the corresponding character in "to". If "to" is shorter than "from", 
X * than the corresponding entries are null, which means that those 
X * characters dissapear altogether. Furthermore, imagine 
X * map(dest, "sourcestring", "srtin", "rn..*") type call. In this case, 
X * `s' maps to `r', `r' maps to `n' and `n' maps to `*'. Thus, `s' 
X * ultimately maps to `*'. In order to achieve this effect in an efficient 
X * manner (i.e. without multiple passes over the destination string), we 
X * loop over mapvec, starting with the initial source character. if the 
X * character value (dch) in this location is different than the source 
X * character (sch), sch becomes dch, once again to index into mapvec, until 
X * the character value stabilizes (i.e. sch = dch, in other words 
X * mapvec[n] == n). Even if the entry in the mapvec is null for an ordinary 
X * character, it will stabilize, since mapvec[0] == 0 at all times. At the 
X * end, we restore mapvec* back to normal where mapvec[n] == n for 
X * 0 <= n <= 127. This strategy, along with the restoration of mapvec, is 
X * about 5 times faster than any algorithm that makes multiple passes over 
X * destination string.
X *
X */
X     
Xmap(dest,src,from,to)
Xregister char *dest;
Xregister char *src;
Xregister char *from;
Xregister char *to;
X{
X        register char *tmp;
X        register char sch, dch;
X        static char mapvec[128] = {
X                0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
X                12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23,
X                24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,
X                36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
X                48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
X                60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71,
X                72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83,
X                84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
X                96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107,
X                108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,
X                120, 121, 122, 123, 124, 125, 126, 127
X        };
X 
X        if (*src) {
X                tmp = from;
X	/*
X	 * create a mapping between "from" and "to"
X	 */
X                while (*from)
X                        mapvec[*from++] = (*to) ? *to++ : (char) 0;
X     
X                while (*src) {
X                        sch = *src++;
X                        dch = mapvec[sch];
X                        while (dch != sch) {
X                                sch = dch;
X                                dch = mapvec[sch];
X                        }
X                        if (*dest = dch)
X                                dest++;
X                }
X	/*
X	 * restore all the changed characters
X	 */
X                while (*tmp) {
X                        mapvec[*tmp] = *tmp;
X                        tmp++;
X                }
X        }
X        *dest = (char) 0;
X}
END_OF_FILE
if test 11554 -ne `wc -c <'serv.c'`; then
    echo shar: \"'serv.c'\" unpacked with wrong size!
fi
# end of 'serv.c'
fi
if test -f 'look.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'look.c'\"
else
echo shar: Extracting \"'look.c'\" \(1617 characters\)
sed "s/^X//" >'look.c' <<'END_OF_FILE'
X/*
X * look.c
X * Facility: m4 macro processor
X * by: oz
X */
X
X#include "mdef.h"
X#include "extr.h"
X
Xextern char *strsave();
X
X/*
X *  hash - compute hash value using the proverbial
X *	   hashing function. Taken from K&R.
X */
Xhash (name)
Xregister char *name;
X{
X	register int h = 0;
X	while (*name)
X		h += *name++;
X	return (h % HASHSIZE);
X}
X
X/*
X * lookup - find name in the hash table
X *
X */
Xndptr lookup(name)
Xchar *name;
X{
X	register ndptr p;
X
X	for (p = hashtab[hash(name)]; p != nil; p = p->nxtptr)
X		if (strcmp(name, p->name) == 0)
X			break;
X	return (p);
X}
X
X/*
X * addent - hash and create an entry in the hash
X *	    table. The new entry is added in front
X *	    of a hash bucket.
X */
Xndptr addent(name)
Xchar *name;
X{
X	register int h;
X	ndptr p;
X
X	h = hash(name);
X	if ((p = (ndptr) malloc(sizeof(struct ndblock))) != NULL) {
X		p->nxtptr = hashtab[h];
X		hashtab[h] = p;
X		p->name = strsave(name);
X	}
X	else
X		error("m4: no more memory.");
X	return p;
X}
X
X/*
X * remhash - remove an entry from the hashtable
X *
X */
Xremhash(name, all)
Xchar *name;
Xint all;
X{
X	register int h;
X	register ndptr xp, tp, mp;
X
X	h = hash(name);
X	mp = hashtab[h];
X	tp = nil;
X	while (mp != nil) {
X		if (strcmp(mp->name, name) == 0) {
X			mp = mp->nxtptr;
X			if (tp == nil) {
X				freent(hashtab[h]);
X				hashtab[h] = mp;
X			}
X			else {
X				xp = tp->nxtptr;
X				tp->nxtptr = mp;
X				freent(xp);
X			}
X			if (!all)
X				break;
X		}
X		else {
X			tp = mp;
X			mp = mp->nxtptr;
X		}
X	}
X}
X
X/*
X * freent - free a hashtable information block
X *
X */
Xfreent(p)
Xndptr p;
X{
X	if (!(p->type & STATIC)) {
X		free(p->name);
X		if (p->defn != null)
X			free(p->defn);
X	}
X	free(p);
X}
X
END_OF_FILE
if test 1617 -ne `wc -c <'look.c'`; then
    echo shar: \"'look.c'\" unpacked with wrong size!
fi
# end of 'look.c'
fi
if test -f 'misc.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'misc.c'\"
else
echo shar: Extracting \"'misc.c'\" \(5005 characters\)
sed "s/^X//" >'misc.c' <<'END_OF_FILE'
X/*
X * misc.c
X * Facility: m4 macro processor
X * by: oz
X */
X 
X#include "mdef.h"
X#include "extr.h" 
X 
Xextern char *malloc();
X 
X/*
X * indx - find the index of second str in the
X *        first str.
X */
Xindx(s1, s2)
Xchar *s1;
Xchar *s2;
X{
X        register char *t;
X        register char *p;
X        register char *m;
X 
X        for (p = s1; *p; p++) {
X                for (t = p, m = s2; *m && *m == *t; m++, t++)
X                        ;
X                if (!*m)
X                        return(p - s1);
X        }
X        return (-1);
X}
X 
X/*
X *  putback - push character back onto input
X *
X */
Xputback (c)
Xchar c;
X{
X        if (bp < endpbb)
X                *bp++ = c;
X        else
X                error("m4: too many characters pushed back");
X}
X 
X/*
X *  pbstr - push string back onto input
X *          putback is replicated to improve
X *          performance.
X *
X */
Xpbstr(s)
Xregister char *s;
X{
X        register char *es;
X	register char *zp;
X
X	es = s;
X	zp = bp;
X
X        while (*es)
X                es++;
X        es--;
X        while (es >= s)
X                if (zp < endpbb)
X                        *zp++ = *es--;
X        if ((bp = zp) == endpbb)
X                error("m4: too many characters pushed back");
X}
X 
X/*
X *  pbnum - convert number to string, push back on input.
X *
X */
Xpbnum (n)
Xint n;
X{
X        register int num;
X 
X        num = (n < 0) ? -n : n;
X        do {
X                putback(num % 10 + '0');
X        }
X        while ((num /= 10) > 0);
X
X        if (n < 0) putback('-');
X}
X 
X/*
X *  chrsave - put single char on string space
X *
X */
Xchrsave (c)
Xchar c;
X{
X/***        if (sp < 0)
X                putc(c, active);
X        else ***/ if (ep < endest)
X                *ep++ = c;
X        else
X                error("m4: string space overflow");
X}
X 
X/*
X * getdiv - read in a diversion file, and
X *          trash it.
X */
Xgetdiv(ind) {
X        register int c;
X        register FILE *dfil;
X 
X        if (active == outfile[ind])
X                error("m4: undivert: diversion still active.");
X        (void) fclose(outfile[ind]);
X        outfile[ind] = NULL;
X        m4temp[UNIQUE] = ind + '0';
X        if ((dfil = fopen(m4temp, "r")) == NULL)
X                error("m4: cannot undivert.");
X        else
X                while((c = getc(dfil)) != EOF)
X                        putc(c, active);
X        (void) fclose(dfil);
X
X#if vms
X        if (remove(m4temp))
X#else
X	if (unlink(m4temp) == -1)
X#endif
X                error("m4: cannot unlink.");
X}
X 
X/*
X * Very fatal error. Close all files
X * and die hard.
X */
Xerror(s)
Xchar *s;
X{
X        killdiv();
X        fprintf(stderr,"%s\n",s);
X        exit(1);
X}
X 
X/*
X * Interrupt handling
X */
Xstatic char *msg = "\ninterrupted.";
X 
Xonintr() {
X        error(msg);
X}
X 
X/*
X * killdiv - get rid of the diversion files
X *
X */
Xkilldiv() {
X        register int n;
X 
X        for (n = 0; n < MAXOUT; n++)
X                if (outfile[n] != NULL) {
X                        (void) fclose (outfile[n]);
X                        m4temp[UNIQUE] = n + '0';
X#if vms
X			(void) remove (m4temp);
X#else
X                        (void) unlink (m4temp);
X#endif
X                }
X}
X 
X/*
X * save a string somewhere..
X *
X */
Xchar *strsave(s)
Xchar *s;
X{
X	register int n;
X        char *p;
X
X        if ((p = malloc (n = strlen(s)+1)) != NULL)
X                (void) memcpy(p, s, n);
X        return (p);
X}
X 
Xusage() {
X        fprintf(stderr, "Usage: m4 [-Dname[=val]] [-Uname]\n");
X        exit(1);
X}
X
X#ifdef GETOPT
X/*
X * H. Spencer getopt - get option letter from argv
X * 
X *
X#include <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
END_OF_FILE
if test 5005 -ne `wc -c <'misc.c'`; then
    echo shar: \"'misc.c'\" unpacked with wrong size!
fi
# end of 'misc.c'
fi
if test -f 'expr.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'expr.c'\"
else
echo shar: Extracting \"'expr.c'\" \(11531 characters\)
sed "s/^X//" >'expr.c' <<'END_OF_FILE'
X
X/*
X *      expression evaluator: performs a standard recursive
X *      descent parse to evaluate any expression permissible
X *      within the following grammar:
X *
X *      expr    :       query EOS
X *      query   :       lor
X *              |       lor "?" query ":" query
X *      lor     :       land { "||" land }
X *      land    :       bor { "&&" bor }
X *      bor     :       bxor { "|" bxor }
X *      bxor    :       band { "^" band }
X *      band    :       eql { "&" eql }
X *      eql     :       relat { eqrel relat }
X *      relat   :       shift { rel shift }
X *      shift   :       primary { shop primary }
X *      primary :       term { addop term }
X *      term    :       unary { mulop unary }
X *      unary   :       factor
X *              |       unop unary
X *      factor  :       constant
X *              |       "(" query ")"
X *      constant:       num
X *              |       "'" CHAR "'"
X *      num     :       DIGIT
X *              |       DIGIT num
X *      shop    :       "<<"
X *              |       ">>"
X *      eqlrel  :       "="
X *              |       "=="
X *              |       "!="
X *      rel     :       "<"
X *              |       ">"
X *              |       "<="
X *              |       ">="
X *
X *
X *      This expression evaluator is lifted from a public-domain
X *      C Pre-Processor included with the DECUS C Compiler distribution.
X *      It is hacked somewhat to be suitable for m4.
X *
X *      Originally by:  Mike Lutz
X *                      Bob Harper
X */
X 
X#define TRUE    1
X#define FALSE   0
X#define EOS     (char) 0
X#define EQL     0
X#define NEQ     1
X#define LSS     2
X#define LEQ     3
X#define GTR     4
X#define GEQ     5
X#define OCTAL   8
X#define DECIMAL 10
X 
Xstatic char *nxtch;     /* Parser scan pointer */
X 
X/*
X * For longjmp
X */
X#include <setjmp.h>
Xstatic jmp_buf  expjump;
X 
X/*
X * macros:
X *
X *      ungetch - Put back the last character examined.
X *      getch   - return the next character from expr string.
X */
X#define ungetch()       nxtch--
X#define getch()         *nxtch++
X 
Xexpr(expbuf)
Xchar *expbuf;
X{
X        register int rval;
X 
X        nxtch = expbuf;
X        if (setjmp(expjump) != 0)
X                return (FALSE);
X        rval = query();
X        if (skipws() == EOS)
X                return(rval);
X        experr("Ill-formed expression");
X}
X 
X/*
X * query : lor | lor '?' query ':' query
X *
X */
Xquery()
X{
X        register int bool, true_val, false_val;
X 
X        bool = lor();
X        if (skipws() != '?') {
X                ungetch();
X                return(bool);
X        }
X 
X        true_val = query();
X        if (skipws() != ':')
X                experr("Bad query");
X 
X        false_val = query();
X        return(bool ? true_val : false_val);
X}
X 
X/*
X * lor : land { '||' land }
X *
X */
Xlor()
X{
X        register int c, vl, vr;
X 
X        vl = land();
X        while ((c = skipws()) == '|' && getch() == '|') {
X                vr = land();
X                vl = vl || vr;
X        }
X 
X        if (c == '|')
X                ungetch();
X        ungetch();
X        return(vl);
X}
X 
X/*
X * land : bor { '&&' bor }
X *
X */
Xland()
X{
X        register int c, vl, vr;
X 
X        vl = bor();
X        while ((c = skipws()) == '&' && getch() == '&') {
X                vr = bor();
X                vl = vl && vr;
X        }
X 
X        if (c == '&')
X                ungetch();
X        ungetch();
X        return(vl);
X}
X 
X/*
X * bor : bxor { '|' bxor }
X *
X */
Xbor()
X{
X        register int vl, vr, c;
X 
X        vl = bxor();
X        while ((c = skipws()) == '|' && getch() != '|') {
X                ungetch();
X                vr = bxor();
X                vl |= vr;
X        }
X 
X        if (c == '|')
X                ungetch();
X        ungetch();
X        return(vl);
X}
X 
X/*
X * bxor : band { '^' band }
X *
X */
Xbxor()
X{
X        register int vl, vr;
X 
X        vl = band();
X        while (skipws() == '^') {
X                vr = band();
X                vl ^= vr;
X        }
X 
X        ungetch();
X        return(vl);
X}
X 
X/*
X * band : eql { '&' eql }
X *
X */
Xband()
X{
X        register int vl, vr, c;
X 
X        vl = eql();
X        while ((c = skipws()) == '&' && getch() != '&') {
X                ungetch();
X                vr = eql();
X                vl &= vr;
X        }
X 
X        if (c == '&')
X                ungetch();
X        ungetch();
X        return(vl);
X}
X 
X/*
X * eql : relat { eqrel relat }
X *
X */
Xeql()
X{
X        register int vl, vr, rel;
X 
X        vl = relat();
X        while ((rel = geteql()) != -1) {
X                vr = relat();
X 
X                switch (rel) {
X 
X                case EQL:
X                        vl = (vl == vr);
X                        break;
X                case NEQ:
X                        vl = (vl != vr);
X                        break;
X                }
X        }
X        return(vl);
X}
X 
X/*
X * relat : shift { rel shift }
X *
X */
Xrelat()
X{
X        register int vl, vr, rel;
X 
X        vl = shift();
X        while ((rel = getrel()) != -1) {
X 
X                vr = shift();
X                switch (rel) {
X 
X                case LEQ:
X                        vl = (vl <= vr);
X                        break;
X                case LSS:
X                        vl = (vl < vr);
X                        break;
X                case GTR:
X                        vl = (vl > vr);
X                        break;
X                case GEQ:
X                        vl = (vl >= vr);
X                        break;
X                }
X        }
X        return(vl);
X}
X 
X/*
X * shift : primary { shop primary }
X *
X */
Xshift()
X{
X        register int vl, vr, c;
X 
X        vl = primary();
X        while (((c = skipws()) == '<' || c == '>') && c == getch()) {
X                vr = primary();
X 
X                if (c == '<')
X                        vl <<= vr;
X                else
X                        vl >>= vr;
X        }
X 
X        if (c == '<' || c == '>')
X                ungetch();
X        ungetch();
X        return(vl);
X}
X 
X/*
X * primary : term { addop term }
X *
X */
Xprimary()
X{
X        register int c, vl, vr;
X 
X        vl = term();
X        while ((c = skipws()) == '+' || c == '-') {
X                vr = term();
X                if (c == '+')
X                        vl += vr;
X                else
X                        vl -= vr;
X        }
X 
X        ungetch();
X        return(vl);
X}
X 
X/*
X * <term> := <unary> { <mulop> <unary> }
X *
X */
Xterm()
X{
X        register int c, vl, vr;
X 
X        vl = unary();
X        while ((c = skipws()) == '*' || c == '/' || c == '%') {
X                vr = unary();
X 
X                switch (c) {
X                case '*':
X                        vl *= vr;
X                        break;
X                case '/':
X                        vl /= vr;
X                        break;
X                case '%':
X                        vl %= vr;
X                        break;
X                }
X        }
X        ungetch();
X        return(vl);
X}
X 
X/*
X * unary : factor | unop unary
X *
X */
Xunary()
X{
X        register int val, c;
X 
X        if ((c = skipws()) == '!' || c == '~' || c == '-') {
X                val = unary();
X 
X                switch (c) {
X                case '!':
X                        return(! val);
X                case '~':
X                        return(~ val);
X                case '-':
X                        return(- val);
X                }
X        }
X 
X        ungetch();
X        return(factor());
X}
X 
X/*
X * factor : constant | '(' query ')'
X *
X */
Xfactor()
X{
X        register int val;
X 
X        if (skipws() == '(') {
X                val = query();
X                if (skipws() != ')')
X                        experr("Bad factor");
X                return(val);
X        }
X 
X        ungetch();
X        return(constant());
X}
X 
X/*
X * constant: num | 'char'
X *
X */
Xconstant()
X{
X        /*
X         * Note: constant() handles multi-byte constants
X         */
X 
X        register int    i;
X        register int    value;
X        register char   c;
X        int             v[sizeof (int)];
X 
X        if (skipws() != '\'') {
X                ungetch();
X                return(num());
X        }
X        for (i = 0; i < sizeof(int); i++) {
X                if ((c = getch()) == '\'') {
X                        ungetch();
X                        break;
X                }
X                if (c == '\\') {
X                        switch (c = getch()) {
X                        case '0':
X                        case '1':
X                        case '2':
X                        case '3':
X                        case '4':
X                        case '5':
X                        case '6':
X                        case '7':
X                                ungetch();
X                                c = num();
X                                break;
X                        case 'n':
X                                c = 012;
X                                break;
X                        case 'r':
X                                c = 015;
X                                break;
X                        case 't':
X                                c = 011;
X                                break;
X                        case 'b':
X                                c = 010;
X                                break;
X                        case 'f':
X                                c = 014;
X                                break;
X                        }
X                }
X                v[i] = c;
X        }
X        if (i == 0 || getch() != '\'')
X                experr("Illegal character constant");
X        for (value = 0; --i >= 0;) {
X                value <<= 8;
X                value += v[i];
X        }
X        return(value);
X}
X 
X/*
X * num : digit | num digit
X *
X */
Xnum()
X{
X        register int rval, c, base;
X        int ndig;
X 
X        base = ((c = skipws()) == '0') ? OCTAL : DECIMAL;
X        rval = 0;
X        ndig = 0;
X        while (c >= '0' && c <= (base == OCTAL ? '7' : '9')) {
X                rval *= base;
X                rval += (c - '0');
X                c = getch();
X                ndig++;
X        }
X        ungetch();
X        if (ndig)
X                return(rval);
X        experr("Bad constant");
X}
X 
X/*
X * eqlrel : '=' | '==' | '!='
X *
X */
Xgeteql()
X{
X        register int c1, c2;
X 
X        c1 = skipws();
X        c2 = getch();
X 
X        switch (c1) {
X 
X        case '=':
X                if (c2 != '=')
X                        ungetch();
X                return(EQL);
X 
X        case '!':
X                if (c2 == '=')
X                        return(NEQ);
X                ungetch();
X                ungetch();
X                return(-1);
X 
X        default:
X                ungetch();
X                ungetch();
X                return(-1);
X        }
X}
X 
X/*
X * rel : '<' | '>' | '<=' | '>='
X *
X */
Xgetrel()
X{
X        register int c1, c2;
X 
X        c1 = skipws();
X        c2 = getch();
X 
X        switch (c1) {
X 
X        case '<':
X                if (c2 == '=')
X                        return(LEQ);
X                ungetch();
X                return(LSS);
X 
X        case '>':
X                if (c2 == '=')
X                        return(GEQ);
X                ungetch();
X                return(GTR);
X 
X        default:
X                ungetch();
X                ungetch();
X                return(-1);
X        }
X}
X 
X/*
X * Skip over any white space and return terminating char.
X */
Xskipws()
X{
X        register char c;
X 
X        while ((c = getch()) <= ' ' && c > EOS)
X                ;
X        return(c);
X}
X 
X/*
X * Error handler - resets environment to eval(), prints an error,
X * and returns FALSE.
X */
Xexperr(msg)
Xchar *msg;
X{
X        printf("mp: %s\n",msg);
X        longjmp(expjump, -1);          /* Force eval() to return FALSE */
X}
END_OF_FILE
if test 11531 -ne `wc -c <'expr.c'`; then
    echo shar: \"'expr.c'\" unpacked with wrong size!
fi
# end of 'expr.c'
fi
echo shar: End of shell archive.
exit 0
-- 
The king: If there's no meaning	   	    Usenet:    oz@nexus.yorku.ca
in it, that saves a world of trouble        ......!uunet!utai!yunexus!oz
you know, as we needn't try to find any.    Bitnet: oz@[yulibra|yuyetti]
Lewis Carroll (Alice in Worderland)         Phonet: +1 416 736-5257x3976

oz@yunexus.UUCP (Ozan Yigit) (08/20/89)

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  ack.m4 hanoi.m4 hash.m4 sqroot.m4 string.m4 test.m4 README
#   MANIFEST m4.1 patchlevel.h
# Wrapped by oz@yunexus on Sun Aug 20 01:09:47 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'ack.m4' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ack.m4'\"
else
echo shar: Extracting \"'ack.m4'\" \(95 characters\)
sed "s/^X//" >'ack.m4' <<'END_OF_FILE'
Xdefine(ack, `ifelse($1,0,incr($2),$2,0,`ack(DECR($1),1)',
X`ack(DECR($1), ack($1,DECR($2)))')')
END_OF_FILE
if test 95 -ne `wc -c <'ack.m4'`; then
    echo shar: \"'ack.m4'\" unpacked with wrong size!
fi
# end of 'ack.m4'
fi
if test -f 'hanoi.m4' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hanoi.m4'\"
else
echo shar: Extracting \"'hanoi.m4'\" \(189 characters\)
sed "s/^X//" >'hanoi.m4' <<'END_OF_FILE'
Xdefine(hanoi, `trans(A, B, C, $1)')
X
Xdefine(moved,`move disk from $1 to $2
X')
X
Xdefine(trans, `ifelse($4,1,`moved($1,$2)',
X	`trans($1,$3,$2,DECR($4))moved($1,$2)trans($3,$2,$1,DECR($4))')')
END_OF_FILE
if test 189 -ne `wc -c <'hanoi.m4'`; then
    echo shar: \"'hanoi.m4'\" unpacked with wrong size!
fi
# end of 'hanoi.m4'
fi
if test -f 'hash.m4' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'hash.m4'\"
else
echo shar: Extracting \"'hash.m4'\" \(425 characters\)
sed "s/^X//" >'hash.m4' <<'END_OF_FILE'
Xdnl	This probably will not run on any m4 that cannot
Xdnl	handle char constants in eval.
Xdnl
Xchangequote(<,>) define(HASHVAL,99) dnl
Xdefine(hash,<eval(str(substr($1,1),0)%HASHVAL)>) dnl
Xdefine(str,
X	<ifelse($1,",$2,
X		<str(substr(<$1>,1),<eval($2+'substr($1,0,1)')>)>)
X	>) dnl
Xdefine(KEYWORD,<$1,hash($1),>) dnl
Xdefine(TSTART,
X<struct prehash {
X	char *keyword;
X	int   hashval;
X} keytab[] = {>) dnl
Xdefine(TEND,<	"",0
X};>) dnl
END_OF_FILE
if test 425 -ne `wc -c <'hash.m4'`; then
    echo shar: \"'hash.m4'\" unpacked with wrong size!
fi
# end of 'hash.m4'
fi
if test -f 'sqroot.m4' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'sqroot.m4'\"
else
echo shar: Extracting \"'sqroot.m4'\" \(238 characters\)
sed "s/^X//" >'sqroot.m4' <<'END_OF_FILE'
Xdefine(square_root, 
X	`ifelse(eval($1<0),1,negative-square-root,
X			     `square_root_aux($1, 1, eval(($1+1)/2))')')
Xdefine(square_root_aux,
X	`ifelse($3, $2, $3,
X		$3, eval($1/$2), $3,
X		`square_root_aux($1, $3, eval(($3+($1/$3))/2))')')
END_OF_FILE
if test 238 -ne `wc -c <'sqroot.m4'`; then
    echo shar: \"'sqroot.m4'\" unpacked with wrong size!
fi
# end of 'sqroot.m4'
fi
if test -f 'string.m4' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'string.m4'\"
else
echo shar: Extracting \"'string.m4'\" \(204 characters\)
sed "s/^X//" >'string.m4' <<'END_OF_FILE'
X
Xdefine(string,`integer $1(len(substr($2,1)))
Xstr($1,substr($2,1),0)
Xdata $1(len(substr($2,1)))/EOS/
X')
X
Xdefine(str,`ifelse($2,",,data $1(incr($3))/`LET'substr($2,0,1)/
X`str($1,substr($2,1),incr($3))')')
END_OF_FILE
if test 204 -ne `wc -c <'string.m4'`; then
    echo shar: \"'string.m4'\" unpacked with wrong size!
fi
# end of 'string.m4'
fi
if test -f 'test.m4' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'test.m4'\"
else
echo shar: Extracting \"'test.m4'\" \(7933 characters\)
sed "s/^X//" >'test.m4' <<'END_OF_FILE'
X#
X# test file for mp (not comprehensive)
X#
X# v7 m4 does not have `decr'.
X#
Xdefine(DECR,`eval($1-1)')
X#
X# include string macros
X#
Xinclude(string.m4)
X#
X# create some fortrash strings for an even uglier language
X#
Xstring(TEXT, "text")
Xstring(DATA, "data")
Xstring(BEGIN, "begin")
Xstring(END, "end")
Xstring(IF, "if")
Xstring(THEN, "then")
Xstring(ELSE, "else")
Xstring(CASE, "case")
Xstring(REPEAT, "repeat")
Xstring(WHILE, "while")
Xstring(DEFAULT, "default")
Xstring(UNTIL, "until")
Xstring(FUNCTION, "function")
Xstring(PROCEDURE, "procedure")
Xstring(EXTERNAL, "external")
Xstring(FORWARD, "forward")
Xstring(TYPE, "type")
Xstring(VAR, "var")
Xstring(CONST, "const")
Xstring(PROGRAM, "program")
Xstring(INPUT, "input")
Xstring(OUTPUT, "output")
X#
Xdivert(2)
Xdiversion #1
Xdivert(3)
Xdiversion #2
Xdivert(4)
Xdiversion #3
Xdivert(5)
Xdiversion #4
Xdivert(0)
Xdefine(abc,xxx)
Xifdef(`abc',defined,undefined)
X#
X# v7 m4 does this wrong. The right output is 
X# 	this is A vEry lon sEntEnCE
X# see m4 documentation for translit.
X#
Xtranslit(`this is a very long sentence', abcdefg, ABCDEF)
X#
X# include towers-of-hanoi
X#
Xinclude(hanoi.m4)
X#
X# some reasonable set of disks
X#
Xhanoi(6)
X#
X# include ackermann's function
X#
Xinclude(ack.m4)
X#
X# something like (3,3) will blow away un*x m4.
X#
Xack(2,3)
X#
X# include a square_root function for fixed nums
X#
Xinclude(sqroot.m4)
X#
X# some square roots.
X#
Xsquare_root(15)
Xsquare_root(100)
Xsquare_root(-4)
Xsquare_root(21372)
X#
X# some textual material for enjoyment.
X#
X[taken from the 'Clemson University Computer Newsletter',
X September 1981, pp. 6-7]
X     
XI am a wizard in the magical Kingdom of Transformation and I
Xslay dragons for a living.  Actually, I am a systems programmer.
XOne of the problems with systems programming is explaining to
Xnon-computer enthusiasts what that is.  All of the terms I use to
Xdescribe my job are totally meaningless to them.  Usually my response
Xto questions about my work is to say as little as possible.  For
Xinstance, if someone asks what happened at work this week, I say
X"Nothing much" and then I change the subject.
X     
XWith the assistance of my brother, a mechanical engineer, I have devised
Xan analogy that everyone can understand.  The analogy describes the
X"Kingdom of Transformation" where travelers wander and are magically
Xtransformed.  This kingdom is the computer and the travelers are information.
XThe purpose of the computer is to change information to a more meaningful
Xforma.  The law of conservation applies here:  The computer never creates
Xand never intentionally destroys data.  With no further ado, let us travel
Xto the Kingdom of Transformation:
X     
XIn a land far, far away, there is a magical kingdom called the Kingdom of
XTransformation.  A king rules over this land and employs a Council of
XWizardry.  The main purpose of this kingdom is to provide a way for
Xneighboring kingdoms to transform citizens into more useful citizens.  This
Xis done by allowing the citizens to enter the kingdom at one of its ports
Xand to travel any of the many routes in the kingdom.  They are magically
Xtransformed along the way.  The income of the Kingdom of Transformation
Xcomes from the many toll roads within its boundaries.
X     
XThe Kingdom of Transformation was created when several kingdoms got
Xtogether and discovered a mutual need for new talents and abilities for
Xcitizens.  They employed CTK, Inc. (Creators of Transformation, Inc.) to
Xcreate this kingdom.  CTK designed the country, its transportation routes,
Xand its laws of transformation, and created the major highway system.
X     
XHazards
X=======
X     
XBecause magic is not truly controllable, CTK invariably, but unknowingly,
Xcreates dragons.  Dragons are huge fire-breathing beasts which sometimes
Xinjure or kill travelers.  Fortunately, they do not travel, but always
Xremain near their den.
X     
XOther hazards also exist which are potentially harmful.  As the roads
Xbecome older and more weatherbeaten, pot-holes will develop, trees will
Xfall on travelers, etc.  CTK maintenance men are called to fix these
Xproblems.
X     
XWizards
X=======
X     
XThe wizards play a major role in creating and maintaining the kingdom but
Xget little credit for their work because it is performed secretly.  The
Xwizards do not wan the workers or travelers to learn their incantations
Xbecause many laws would be broken and chaos would result.
X     
XCTK's grand design is always general enough to be applicable in many
Xdifferent situations.  As a result, it is often difficult to use.  The
Xfirst duty of the wizards is to tailor the transformation laws so as to be
Xmore beneficial and easier to use in their particular environment.
X     
XAfter creation of the kingdom, a major duty of the wizards is to search for
Xand kill dragons.  If travelers do not return on time or if they return
Xinjured, the ruler of the country contacts the wizards.  If the wizards
Xdetermine that the injury or death occurred due to the traveler's
Xnegligence, they provide the traveler's country with additional warnings.
XIf not, they must determine if the cause was a road hazard or a dragon.  If
Xthe suspect a road hazard, they call in a CTK maintenance man to locate the
Xhazard and to eliminate it, as in repairing the pothole in the road.  If
Xthey think that cause was a dragon, then they must find and slay it.
X     
XThe most difficult part of eliminating a dragon is finding it.  Sometimes
Xthe wizard magically knows where the dragon's lair it, but often the wizard
Xmust send another traveler along the same route and watch to see where he
Xdisappears.  This sounds like a failsafe method for finding dragons (and a
Xsuicide mission for thr traveler) but the second traveler does not always
Xdisappear.  Some dragons eat any traveler who comes too close; others are
Xvery picky.
X     
XThe wizards may call in CTK who designed the highway system and
Xtransformation laws to help devise a way to locate the dragon.  CTK also
Xhelps provide the right spell or incantation to slay the dragon. (There is
Xno general spell to slay dragons; each dragon must be eliminated with a
Xdifferent spell.)
X     
XBecause neither CTK nor wizards are perfect, spells to not always work
Xcorrectly.  At best, nothing happens when the wrong spell is uttered.  At
Xworst, the dragon becomes a much larger dragon or multiplies into several
Xsmaller ones.  In either case, new spells must be found.
X     
XIf all existing dragons are quiet (i.e. have eaten sufficiently), wizards
Xhave time to do other things.  They hide in castles and practice spells and
Xincatations.  They also devise shortcuts for travelers and new laws of
Xtransformation.
X     
XChanges in the Kingdom
X======================
X     
XAs new transformation kingdoms are created and old ones are maintained,
XCTK, Inc. is constantly learning new things.  It learns ways to avoid
Xcreating some of the dragons that they have previously created.  It also
Xdiscovers new and better laws of transformation.  As a result, CTK will
Xperiodically create a new grand design which is far better than the old.
XThe wizards determine when is a good time to implement this new design.
XThis is when the tourist season is slow or when no important travelers
X(VIPs) are to arrive.  The kingdom must be closed for the actual
Ximplementation and is leter reopened as a new and better place to go.
X     
XA final question you might ask is what happens when the number of tourists
Xbecomes too great for the kingdom to handle in a reasonable period of time
X(i.e., the tourist lines at the ports are too long).  The Kingdom of
XTransformation has three options: (1) shorten the paths that a tourist must
Xtravel, or (2) convince CTK to develop a faster breed of horses so that the
Xtravelers can finish sooner, or (3) annex more territories so that the
Xkingdom can handle more travelers.
X     
XThus ends the story of the Kingdom of Transformation.  I hope this has
Xexplained my job to you:  I slay dragons for a living.
X
X#
X#should do an automatic undivert..
X#
END_OF_FILE
if test 7933 -ne `wc -c <'test.m4'`; then
    echo shar: \"'test.m4'\" unpacked with wrong size!
fi
# end of 'test.m4'
fi
if test -f 'README' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(2891 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XWhat you have here is a completely PD implementation of M4. It was
Xoriginally written for the GNU project.  This version was the last version
Xbefore a major re-write took place.
X
XPd M4 is based on software tools macro, as described in the two tools
Xbooks by Kernighan and Plauger. Although some serious changes have been
Xmade, this version inherits the basic design problems of the original,
Xhence the ugliness of the underlying code.
X
XPDness:
X
XThis code *is* PD. You (public) have all the rights to the code.  [But
Xthis also means you (singular) do not have any *extra* rights to the code,
Xhence it is impossible for you to restrict the use and distribution of
Xthis code (original) in any way.]
X
XDedication:
X
XThis posting is a dedication to an old 750 that started out running 4.1BSD
Xand had 1.5 meg, 1 dz11, and 2 Rk07 drives.  It was named yetti [sic] by
Xaccident, and was managed by the author until its retirement two years
Xago. [the name yetti now identifies a different machine]
X
XDistribution + misc:
X
XThe distribution includes a small test suite, the sources and a man page.
Xtexinfo document is not included. The makefile is pretty simple. See the
Xmakefile for configuration options.  Try "make time" for some timing
Xcomparisons between your un*x m4 and the pd m4. [It should be slighly
Xslower than V7 m4, and slightly faster than SV m4]. Make sure to set MBIN
Xto indicate the location of un*x m4. See the test suite (test.m4) for some
Xadditional comments about pd m4 vs un*x m4.
X
XSome thoughts:
X
XM4 is a neat macro processor but probably a bit outdated by now. It does
Xnot need gratuitous additions, or "features", but a complete re-write. As
Xit stands, it is powerful enough for most macro processing needs. We have,
Xfor example, used it to build a configuration language for DECNET under
XVMS. It can be a handy software engineering tool under most circumstances,
Xand can displace a lot of meaningless little hacks written in C, pascal or
Xwhatever.  [See some net postings for references.]
X
XSuggestions for hacking:
X
XIf you want to hack M4 further, you may wish to implement the SV m4
X"trace" facility, and extended (5-char) Comment/Quote definitions.  This
Xversion also needs some dynamicity for its data structures, and the
Xability to handle multiple file names in the command line. If you want to
Xadd "features", you may wish to first think about implementing the
X"feature" as an M4 macro.  If you really want to elevate this processor
Xinto a more state-of the-art tool, than you should probably re-write it.
X
XFeedback:
X
XIf you have any important fixes and/or speed improvements, I am much
Xinterested. I am also interested in hearing about any unique applica-
Xtions of M4. I am NOT interested in gratuitous hacks or "neat"
Xkitchen-sink features. 
X
XAuthor:
X	Usenet: uunet!utai!yunexus!oz || oz@nexus.yorku.ca
X	Bitnet: oz@yulibra.BITNET
X	Phonet: [416] 736-5257 x 3976
X
X
Xenjoy.	oz
END_OF_FILE
if test 2891 -ne `wc -c <'README'`; then
    echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'MANIFEST' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'MANIFEST'\"
else
echo shar: Extracting \"'MANIFEST'\" \(230 characters\)
sed "s/^X//" >'MANIFEST' <<'END_OF_FILE'
Xmdef.h	- definitions and structures
Xmain.c	- this file: driver routines
Xeval.c	- general macro evaluator
Xserv.c	- service routines (doxxxx)
Xmisc.c	- miscellaneous routines
Xexpr.c	- expression parser
Xlook.c	- hash table management
END_OF_FILE
if test 230 -ne `wc -c <'MANIFEST'`; then
    echo shar: \"'MANIFEST'\" unpacked with wrong size!
fi
# end of 'MANIFEST'
fi
if test -f 'm4.1' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'m4.1'\"
else
echo shar: Extracting \"'m4.1'\" \(9644 characters\)
sed "s/^X//" >'m4.1' <<'END_OF_FILE'
X.TH M4 local "30 Aug 1987"
X.DA 08 Jan 1986
X.SH NAME
Xpd m4 \- macro processor
X.SH ORIGIN
XMetaSystems
X.SH SYNOPSIS
X.BI m4 "[ options ]"
X.SH DESCRIPTION
X.I Pd M4
Xis a un*x M4 look-alike macro processor
Xintended as a front end for Ratfor, Pascal, and other languages that do not
Xhave a built-in macro processing capability.
XPd M4 reads standard input, the processed text is written on the standard output.
X.PP
XThe options and their effects are as follows:
X.TP
X\f3\-D\fP\f2name\^\fP[\f3=\fP\f2val\^\fP]
XDefines
X.I name
Xto
X.I val
Xor to null in
X.IR val 's
Xabsence.
X.TP
X.BI \-U name
Xundefines
X.IR name .
X.PP
XMacro calls
Xhave the form:
X.PP
X.RS
X\fBname\fI(arg1,arg2, .\|.\|., argn)\fR
X.RE
X.PP
XThe
X.B (
Xmust immediately follow the name of the macro.
XIf the name of a defined macro is not followed by a
X.BR ( ,
Xit is taken to be a call of that macro with no arguments, i.e. name().
XPotential macro names consist of alphabetic letters and digits.
X.PP
XLeading unquoted blanks, tabs and newlines are ignored while collecting 
Xarguments.
XLeft and right single quotes are used to quote strings.
XThe value of a quoted string is the string stripped of the quotes.
X.PP
XWhen a macro name is recognized,
Xits arguments are collected by searching for a matching
X.BR ) .
XIf fewer arguments are supplied than are in the macro definition,
Xthe trailing arguments are taken to be null.
XMacro evaluation proceeds normally during the collection of the arguments,
Xand any commas or right parentheses
Xwhich happen to turn up within the value of a nested
Xcall are as effective as those in the original input text. (This is typically
Xreferred as
X.I inside-out
Xmacro expansion.)
XAfter argument collection,
Xthe value of the macro is pushed back onto the input stream
Xand rescanned.
X.PP
X.I Pd M4
Xmakes available the following built-in macros.
XThey may be redefined, but once this is done the original meaning is lost.
XTheir values are null unless otherwise stated.
X.de MC
X.TP 14
X.B \\$1
Xusage: \\fI\\$1\\$2\\fR
X.br
X..
X.MC define "(name [, val])"
Xthe second argument is installed as the value of the macro
Xwhose name is the first argument. If there is no second argument,
Xthe value is null.
XEach occurrence of
X.BI $ n
Xin the replacement text,
Xwhere
X.I n
Xis a digit,
Xis replaced by the
X.IR n -th
Xargument.
XArgument 0 is the name of the macro;
Xmissing arguments are replaced by the null string.
X.MC defn "(name [, name ...])
Xreturns the quoted definition of its argument(s). Useful in renaming
Xmacros.
X.MC undefine "(name [, name ...])"
Xremoves the definition of the macro(s) named. If there is
Xmore than one definition for the named macro, (due to previous use of
X.IR pushdef ) 
Xall definitions are removed.
X.MC pushdef "(name [, val])"
Xlike
X.IR define ,
Xbut saves any previous definition by stacking the current definition.
X.MC popdef "(name [, name ...])"
Xremoves current definition of its argument(s),
Xexposing the previous one if any.
X.MC ifdef "(name, if-def [, ifnot-def])"
Xif the first argument is defined, the value is the second argument, 
Xotherwise the third.
XIf there is no third argument, the value is null.
XA word indicating the current operating system is predefined.
X(e.g.
X.I unix
Xor
X.IR vms )
X.MC shift "(arg, arg, arg, ...)"
Xreturns all but its first argument.
XThe other arguments are quoted and pushed back with
Xcommas in between.
XThe quoting nullifies the effect of the extra scan that
Xwill subsequently be performed.
X.MC changequote "(lqchar, rqchar)"
Xchange quote symbols to the first and second arguments.
XWith no arguments, the quotes are reset back to the default
Xcharacters. (i.e., \*`\|\*').
X.MC changecom "(lcchar, rcchar)"
Xchange left and right comment markers from the default
X.B #
Xand 
X.BR newline .
XWith no arguments, the comment mechanism is reset back to 
Xthe default characters.
XWith one argument, the left marker becomes the argument and
Xthe right marker becomes newline.
XWith two arguments, both markers are affected.
X.MC divert "(divnum)"
X.I m4
Xmaintains 10 output streams,
Xnumbered 0-9.  initially stream 0 is the current stream. 
XThe
X.I divert
Xmacro changes the current output stream to its (digit-string)
Xargument.
XOutput diverted to a stream other than 0 through 9
Xdisappears into bitbucket.
X.MC undivert "([divnum [, divnum ...]])"
Xcauses immediate output of text from diversions named as
Xargument(s), or all diversions if no argument.
XText may be undiverted into another diversion.
XUndiverting discards the diverted text. At the end of input processing,
X.I M4
Xforces an automatic
X.IR undivert ,
Xunless
X.I m4wrap
Xis defined.
X.MC divnum "()"
Xreturns the value of the current output stream.
X.MC dnl "()"
Xreads and discards characters up to and including the next newline.
X.MC ifelse "(arg, arg, if-same [, ifnot-same | arg, arg ...])"
Xhas three or more arguments.
XIf the first argument is the same string as the second,
Xthen the value is the third argument.
XIf not, and if there are more than four arguments, the process is 
Xrepeated with arguments 4, 5, 6 and 7.
XOtherwise, the value is either the fourth string, or, if it is not present,
Xnull.
X.MC incr "(num)"
Xreturns the value of its argument incremented by 1.
XThe value of the argument is calculated
Xby interpreting an initial digit-string as a decimal number.
X.MC decr "(num)"
Xreturns the value of its argument decremented by 1.
X.MC eval "(expression)"
Xevaluates its argument as a constant expression, using integer arithmetic.
XThe evaluation mechanism is very similar to that of
X.I cpp
X(#if expression). 
XThe expression can involve only integer constants and character constants,
Xpossibly connected by the binary operators
X.nf
X.ft B
X
X*	/	%	+	-	>>	<<	<	>	
X<=	>=	==	!=	&	^	|	&&	||
X
X.ft R
X.fi
Xor the unary operators \fB\- ~ !\fR
Xor by the ternary operator \fB ? : \fR.
XParentheses may be used for grouping. Octal numbers may be specified as
Xin C.
X.MC len "(string)"
Xreturns the number of characters in its argument.
X.MC index "(search-string, string)"
Xreturns the position in its first argument where the second argument 
Xbegins (zero origin),
Xor \-1 if the second argument does not occur.
X.MC substr "(string, index [, length])"
Xreturns a substring of its first argument.
XThe second argument is a zero origin
Xnumber selecting the first character (internally treated as an expression);
Xthe third argument indicates the length of the substring.
XA missing third argument is taken to be large enough to extend to
Xthe end of the first string. 
X.MC translit "(source, from [, to])"
Xtransliterates the characters in its first argument
Xfrom the set given by the second argument to the set given by the third.
XIf the third argument is shorter than the second, all extra characters
Xin the second argument are deleted from the first argument. If the third
Xargument is missing altogether, all characters in the second argument are
Xdeleted from the first argument.
X.MC include "(filename)"
Xreturns the contents of the file named in the argument.
X.MC sinclude "(filename)"
Xis identical to
X.IR include ,
Xexcept that it
Xsays nothing if the file is inaccessible.
X.MC paste "(filename)"
Xreturns the contents of the file named in the argument without any
Xprocessing, unlike 
X.IR include.
X.MC spaste "(filename)"
Xis identical to
X.IR paste ,
Xexcept that it says nothing if the file is inaccessible.
X.MC syscmd "(command)"
Xexecutes the
X.SM UNIX
Xcommand given in the first argument.
XNo value is returned.
X.MC sysval "()"
Xis the return code from the last call to
X.IR syscmd .
X.MC maketemp "(string)"
Xfills in a string of
X.SM XXXXXX
Xin its argument with the current process
X.SM ID\*S.
X.MC m4exit "([exitcode])"
Xcauses immediate exit from
X.IR m4 .
XArgument 1, if given, is the exit code;
Xthe default is 0.
X.MC m4wrap "(m4-macro-or-built-in)"
Xargument 1 will be pushed back at final
X.BR EOF ;
Xexample: m4wrap(`dumptable()').
X.MC errprint "(str [, str, str, ...])"
Xprints its argument(s) on stderr. If there is more than one argument,
Xeach argument is separated by a space during the output.
X.MC dumpdef "([name, name, ...])"
Xprints current names and definitions,
Xfor the named items, or for all if no arguments are given.
X.dt
X.SH AUTHOR
XOzan S. Yigit (oz)
X.SH BUGS
XPd M4 is distributed at the source level, and does not require an expensive
Xlicense agreement.
X.PP
XA sufficiently complex M4 macro set is about as readable
Xas
X.BR APL .
X.PP
XAll complex uses of M4 require the ability to program in deep recursion.
XPrevious lisp experience is recommended.
X.PP
XPd M4 is slower than V7 M4.
X.SH EXAMPLES
X.PP
XThe following macro program illustrates the type of things that
Xcan be done with M4. 
X.PP
X.RS
X.nf
X\fBchangequote\fR(<,>) \fBdefine\fR(HASHVAL,99) \fBdnl\fR
X\fBdefine\fR(hash,<\fBexpr\fR(str(\fBsubstr\fR($1,1),0)%HASHVAL)>) \fBdnl\fR
X\fBdefine\fR(str,
X	<\fBifelse\fR($1,",$2,
X		<str(\fBsubstr\fR(<$1>,1),<\fBexpr\fR($2+'\fBsubstr\fR($1,0,1)')>)>)
X	>) \fBdnl\fR
X\fBdefine\fR(KEYWORD,<$1,hash($1),>) \fBdnl\fR
X\fBdefine\fR(TSTART,
X<struct prehash {
X	char *keyword;
X	int   hashval;
X} keytab[] = {>) \fBdnl\fR
X\fBdefine\fR(TEND,<	"",0
X};>) \fBdnl\fR
X.fi
X.RE
X.PP
XThus a keyword table containing the keyword string and its pre-calculated
Xhash value may be generated thus:
X.PP
X.RS
X.nf
XTSTART
X	KEYWORD("foo")
X	KEYWORD("bar")
X	KEYWORD("baz")
XTEND
X.fi
X.RE
X.PP
Xwhich will expand into:
X.RS
X.nf
Xstruct prehash {
X	char *keyword;
X	int   hashval;
X} keytab[] = {
X	"foo",27,
X	"bar",12,
X	"baz",20,
X	"",0
X};
X.fi
X.RE
X.PP
XPresumably, such a table would speed up the installation of the
Xkeywords into a dynamic hash table. (Note that the above macro
Xcannot be used with 
X.IR M4 , 
Xsince 
X.B eval
Xdoes not handle character constants.)
X
X.SH SEE ALSO
Xcc(1),
Xm4(1),
Xcpp(1).
X.I "The M4 Macro Processor\^"
Xby B. W. Kernighan and D. M. Ritchie.
X
END_OF_FILE
if test 9644 -ne `wc -c <'m4.1'`; then
    echo shar: \"'m4.1'\" unpacked with wrong size!
fi
# end of 'm4.1'
fi
if test -f 'patchlevel.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'patchlevel.h'\"
else
echo shar: Extracting \"'patchlevel.h'\" \(21 characters\)
sed "s/^X//" >'patchlevel.h' <<'END_OF_FILE'
X#define PATCHLEVEL 1
END_OF_FILE
if test 21 -ne `wc -c <'patchlevel.h'`; then
    echo shar: \"'patchlevel.h'\" unpacked with wrong size!
fi
# end of 'patchlevel.h'
fi
echo shar: End of shell archive.
exit 0
-- 
The king: If there's no meaning	   	    Usenet:    oz@nexus.yorku.ca
in it, that saves a world of trouble        ......!uunet!utai!yunexus!oz
you know, as we needn't try to find any.    Bitnet: oz@[yulibra|yuyetti]
Lewis Carroll (Alice in Worderland)         Phonet: +1 416 736-5257x3976