ast@cs.vu.nl (09/07/89)
: This is a shar archive. Extract with sh, not csh.
: This archive ends with exit, so do not worry about trailing junk.
: --------------------------- cut here --------------------------
PATH=/bin:/usr/bin:/usr/ucb
echo Extracting 'look.c'
sed 's/^X//' > 'look.c' << '+ END-OF-FILE ''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
+ END-OF-FILE look.c
chmod 'u=rw,g=r,o=r' 'look.c'
set `wc -c 'look.c'`
count=$1
case $count in
1617) :;;
*) echo 'Bad character count in ''look.c' >&2
echo 'Count should be 1617' >&2
esac
echo Extracting 'm4.1'
sed 's/^X//' > 'm4.1' << '+ END-OF-FILE ''m4.1'
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 m4.1
chmod 'u=rw,g=r,o=r' 'm4.1'
set `wc -c 'm4.1'`
count=$1
case $count in
9644) :;;
*) echo 'Bad character count in ''m4.1' >&2
echo 'Count should be 9644' >&2
esac
echo Extracting 'main.c'
sed 's/^X//' > 'main.c' << '+ END-OF-FILE ''main.c'
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 main.c
chmod 'u=rw,g=r,o=r' 'main.c'
set `wc -c 'main.c'`
count=$1
case $count in
11085) :;;
*) echo 'Bad character count in ''main.c' >&2
echo 'Count should be 11085' >&2
esac
echo Extracting 'makefile'
sed 's/^X//' > 'makefile' << '+ END-OF-FILE ''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 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 makefile
chmod 'u=rw,g=r,o=r' 'makefile'
set `wc -c 'makefile'`
count=$1
case $count in
1417) :;;
*) echo 'Bad character count in ''makefile' >&2
echo 'Count should be 1417' >&2
esac
echo Extracting 'mdef.h'
sed 's/^X//' > 'mdef.h' << '+ END-OF-FILE ''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)
+ END-OF-FILE mdef.h
chmod 'u=rw,g=r,o=r' 'mdef.h'
set `wc -c 'mdef.h'`
count=$1
case $count in
4711) :;;
*) echo 'Bad character count in ''mdef.h' >&2
echo 'Count should be 4711' >&2
esac
echo Extracting 'misc.c'
sed 's/^X//' > 'misc.c' << '+ END-OF-FILE ''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
+ END-OF-FILE misc.c
chmod 'u=rw,g=r,o=r' 'misc.c'
set `wc -c 'misc.c'`
count=$1
case $count in
5005) :;;
*) echo 'Bad character count in ''misc.c' >&2
echo 'Count should be 5005' >&2
esac
echo Extracting 'patchlevel.h'
sed 's/^X//' > 'patchlevel.h' << '+ END-OF-FILE ''patchlevel.h'
X#define PATCHLEVEL 1
+ END-OF-FILE patchlevel.h
chmod 'u=rw,g=r,o=r' 'patchlevel.h'
set `wc -c 'patchlevel.h'`
count=$1
case $count in
21) :;;
*) echo 'Bad character count in ''patchlevel.h' >&2
echo 'Count should be 21' >&2
esac
echo Extracting 'serv.c'
sed 's/^X//' > 'serv.c' << '+ END-OF-FILE ''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}
+ END-OF-FILE serv.c
chmod 'u=rw,g=r,o=r' 'serv.c'
set `wc -c 'serv.c'`
count=$1
case $count in
11554) :;;
*) echo 'Bad character count in ''serv.c' >&2
echo 'Count should be 11554' >&2
esac
echo Extracting 'sqroot.m4'
sed 's/^X//' > 'sqroot.m4' << '+ END-OF-FILE ''sqroot.m4'
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 sqroot.m4
chmod 'u=rw,g=r,o=r' 'sqroot.m4'
set `wc -c 'sqroot.m4'`
count=$1
case $count in
238) :;;
*) echo 'Bad character count in ''sqroot.m4' >&2
echo 'Count should be 238' >&2
esac
echo Extracting 'string.m4'
sed 's/^X//' > 'string.m4' << '+ END-OF-FILE ''string.m4'
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 string.m4
chmod 'u=rw,g=r,o=r' 'string.m4'
set `wc -c 'string.m4'`
count=$1
case $count in
204) :;;
*) echo 'Bad character count in ''string.m4' >&2
echo 'Count should be 204' >&2
esac
echo Extracting 'test.m4'
sed 's/^X//' > 'test.m4' << '+ END-OF-FILE ''test.m4'
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 test.m4
chmod 'u=rw,g=r,o=r' 'test.m4'
set `wc -c 'test.m4'`
count=$1
case $count in
7933) :;;
*) echo 'Bad character count in ''test.m4' >&2
echo 'Count should be 7933' >&2
esac
exit 0