[comp.sources.amiga] M4

ain@j.cc.purdue.edu (Patrick White) (06/01/88)

Submitted by:	kuhling!jonasf  (Jonas Flygare)
Summary:	unix m4 look-alike macro processor.
Poster Boy:	Patrick White	(ain@j.cc.purdue.edu)
Archive Name:	sources/amiga/volume5/m4.docs.sh.Z binaries/amiga/volume6/m4.docs.sh.Z
tested.
 
NOTES:
   I undid the shar to undo the uuencoded compressed files, and to separate
the docs from everything else.
   I nroffed the docs so everybody gets a readable copy of the docs.
   A patch to some of the test files was included with the origional posting..
I applied the patch to the files and excluded the patch from this posting.
.
 
 
-- Pat White   (co-moderator comp.sources/binaries.amiga)
ARPA/UUCP: j.cc.purdue.edu!ain  BITNET: PATWHITE@PURCCVM  PHONE: (317) 743-8421
U.S.  Mail:  320 Brown St. apt. 406,    West Lafayette, IN 47906
 
========================================
 
#	This is a shell archive.
#	Remove everything above and including the cut line.
#	Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar:	Shell Archiver
#	Run the following text with /bin/sh to create:
#	m4.man
#	readme
#	readme.flax
#	ack.m4
#	hanoi.m4
#	hash.m4
#	sqroot.m4
#	string.m4
#	test.m4
# This archive created: Mon May 16 09:17:19 1988
# By:	Patrick White (PUCC Land, USA)
echo shar: extracting m4.man '(15241 characters)'
cat << \SHAR_EOF > m4.man



M4(local)           UNIX Programmer's Manual            M4(local)



NAME
     pd m4 - macro processor

ORIGIN
     MetaSystems

SYNOPSIS
     m4[ _o_p_t_i_o_n_s ]

DESCRIPTION
     _P_d _M_4 is a un*x M4 look-alike macro processor intended as a
     front end for Ratfor, Pascal, and other languages that do
     not have a built-in macro processing capability.  Pd M4
     reads standard input, the processed text is written on the
     standard output.

     The options and their effects are as follows:

     -D_n_a_m_e[=_v_a_l]
          Defines _n_a_m_e to _v_a_l or to null in _v_a_l's absence.

     -U_n_a_m_e
          undefines _n_a_m_e.

     Macro calls have the form:

          name(_a_r_g_1,_a_r_g_2, ..., _a_r_g_n)

     The ( must immediately follow the name of the macro.  If the
     name of a defined macro is not followed by a (, it is taken
     to be a call of that macro with no arguments, i.e. name().
     Potential macro names consist of alphabetic letters and
     digits.

     Leading unquoted blanks, tabs and newlines are ignored while
     collecting arguments.  Left and right single quotes are used
     to quote strings.  The value of a quoted string is the
     string stripped of the quotes.

     When a macro name is recognized, its arguments are collected
     by searching for a matching ).  If fewer arguments are sup-
     plied than are in the macro definition, the trailing argu-
     ments are taken to be null.  Macro evaluation proceeds nor-
     mally during the collection of the arguments, and any commas
     or right parentheses which happen to turn up within the
     value of a nested call are as effective as those in the ori-
     ginal input text. (This is typically referred as _i_n_s_i_d_e-_o_u_t
     macro expansion.) After argument collection, the value of
     the macro is pushed back onto the input stream and res-
     canned.





Printed 5/16/88            30 Aug 1987                          1






M4(local)           UNIX Programmer's Manual            M4(local)



     _P_d _M_4 makes available the following built-in macros.  They
     may be redefined, but once this is done the original meaning
     is lost.  Their values are null unless otherwise stated.

     define        usage: _d_e_f_i_n_e(_n_a_m_e [, _v_a_l])
                   the second argument is installed as the value
                   of the macro whose name is the first argument.
                   If there is no second argument, the value is
                   null.  Each occurrence of $_n in the replace-
                   ment text, where _n is a digit, is replaced by
                   the _n-th argument.  Argument 0 is the name of
                   the macro; missing arguments are replaced by
                   the null string.

     defn          usage: _d_e_f_n(_n_a_m_e [, _n_a_m_e ...])
                   returns the quoted definition of its
                   argument(s). Useful in renaming macros.

     undefine      usage: _u_n_d_e_f_i_n_e(_n_a_m_e [, _n_a_m_e ...])
                   removes the definition of the macro(s) named.
                   If there is more than one definition for the
                   named macro, (due to previous use of _p_u_s_h_d_e_f)
                   all definitions are removed.

     pushdef       usage: _p_u_s_h_d_e_f(_n_a_m_e [, _v_a_l])
                   like _d_e_f_i_n_e, but saves any previous definition
                   by stacking the current definition.

     popdef        usage: _p_o_p_d_e_f(_n_a_m_e [, _n_a_m_e ...])
                   removes current definition of its argument(s),
                   exposing the previous one if any.

     ifdef         usage: _i_f_d_e_f(_n_a_m_e, _i_f-_d_e_f [, _i_f_n_o_t-_d_e_f])
                   if the first argument is defined, the value is
                   the second argument, otherwise the third.  If
                   there is no third argument, the value is null.
                   A word indicating the current operating system
                   is predefined.  (e.g.  _u_n_i_x or _v_m_s)

     shift         usage: _s_h_i_f_t(_a_r_g, _a_r_g, _a_r_g, ...)
                   returns all but its first argument.  The other
                   arguments are quoted and pushed back with com-
                   mas in between.  The quoting nullifies the
                   effect of the extra scan that will subse-
                   quently be performed.

     changequote   usage: _c_h_a_n_g_e_q_u_o_t_e(_l_q_c_h_a_r, _r_q_c_h_a_r)
                   change quote symbols to the first and second
                   arguments.  With no arguments, the quotes are
                   reset back to the default characters. (i.e.,
                   ).




Printed 5/16/88            30 Aug 1987                          2






M4(local)           UNIX Programmer's Manual            M4(local)



     changecom     usage: _c_h_a_n_g_e_c_o_m(_l_c_c_h_a_r, _r_c_c_h_a_r)
                   change left and right comment markers from the
                   default # and newline.  With no arguments, the
                   comment mechanism is reset back to the default
                   characters.  With one argument, the left
                   marker becomes the argument and the right
                   marker becomes newline.  With two arguments,
                   both markers are affected.

     divert        usage: _d_i_v_e_r_t(_d_i_v_n_u_m)
                   _m_4 maintains 10 output streams, numbered 0-9.
                   initially stream 0 is the current stream. The
                   _d_i_v_e_r_t macro changes the current output stream
                   to its (digit-string) argument.  Output
                   diverted to a stream other than 0 through 9
                   disappears into bitbucket.

     undivert      usage: _u_n_d_i_v_e_r_t([_d_i_v_n_u_m [, _d_i_v_n_u_m ...]])
                   causes immediate output of text from diver-
                   sions named as argument(s), or all diversions
                   if no argument.  Text may be undiverted into
                   another diversion.  Undiverting discards the
                   diverted text. At the end of input processing,
                   _M_4 forces an automatic _u_n_d_i_v_e_r_t, unless _m_4_w_r_a_p
                   is defined.

     divnum        usage: _d_i_v_n_u_m()
                   returns the value of the current output
                   stream.

     dnl           usage: _d_n_l()
                   reads and discards characters up to and
                   including the next newline.

     ifelse        usage: _i_f_e_l_s_e(_a_r_g, _a_r_g, _i_f-_s_a_m_e [, _i_f_n_o_t-_s_a_m_e
                   | _a_r_g, _a_r_g ...])
                   has three or more arguments.  If the first
                   argument is the same string as the second,
                   then the value is the third argument.  If not,
                   and if there are more than four arguments, the
                   process is repeated with arguments 4, 5, 6 and
                   7.  Otherwise, the value is either the fourth
                   string, or, if it is not present, null.

     incr          usage: _i_n_c_r(_n_u_m)
                   returns the value of its argument incremented
                   by 1.  The value of the argument is calculated
                   by interpreting an initial digit-string as a
                   decimal number.

     decr          usage: _d_e_c_r(_n_u_m)
                   returns the value of its argument decremented



Printed 5/16/88            30 Aug 1987                          3






M4(local)           UNIX Programmer's Manual            M4(local)



                   by 1.

     eval          usage: _e_v_a_l(_e_x_p_r_e_s_s_i_o_n)
                   evaluates its argument as a constant expres-
                   sion, using integer arithmetic.  The evalua-
                   tion mechanism is very similar to that of _c_p_p
                   (#if expression). The expression can involve
                   only integer constants and character con-
                   stants, possibly connected by the binary
                   operators

                   *    /    %    +    -    >>   <<   <    >
                   <=   >=   ==   !=   &    ^    |    &&   ||

                   or the unary operators - ~ !  or by the ter-
                   nary operator  ? : .  Parentheses may be used
                   for grouping. Octal numbers may be specified
                   as in C.

     len           usage: _l_e_n(_s_t_r_i_n_g)
                   returns the number of characters in its argu-
                   ment.

     index         usage: _i_n_d_e_x(_s_e_a_r_c_h-_s_t_r_i_n_g, _s_t_r_i_n_g)
                   returns the position in its first argument
                   where the second argument begins (zero ori-
                   gin), or -1 if the second argument does not
                   occur.

     substr        usage: _s_u_b_s_t_r(_s_t_r_i_n_g, _i_n_d_e_x [, _l_e_n_g_t_h])
                   returns a substring of its first argument.
                   The second argument is a zero origin number
                   selecting the first character (internally
                   treated as an expression); the third argument
                   indicates the length of the substring.  A
                   missing third argument is taken to be large
                   enough to extend to the end of the first
                   string.

     translit      usage: _t_r_a_n_s_l_i_t(_s_o_u_r_c_e, _f_r_o_m [, _t_o])
                   transliterates the characters in its first
                   argument from the set given by the second
                   argument to the set given by the third.  If
                   the third argument is shorter than the second,
                   all extra characters in the second argument
                   are deleted from the first argument. If the
                   third argument is missing altogether, all
                   characters in the second argument are deleted
                   from the first argument.

     include       usage: _i_n_c_l_u_d_e(_f_i_l_e_n_a_m_e)
                   returns the contents of the file named in the



Printed 5/16/88            30 Aug 1987                          4






M4(local)           UNIX Programmer's Manual            M4(local)



                   argument.

     sinclude      usage: _s_i_n_c_l_u_d_e(_f_i_l_e_n_a_m_e)
                   is identical to _i_n_c_l_u_d_e, except that it says
                   nothing if the file is inaccessible.

     paste         usage: _p_a_s_t_e(_f_i_l_e_n_a_m_e)
                   returns the contents of the file named in the
                   argument without any processing, unlike
                   _i_n_c_l_u_d_e.

     spaste        usage: _s_p_a_s_t_e(_f_i_l_e_n_a_m_e)
                   is identical to _p_a_s_t_e, except that it says
                   nothing if the file is inaccessible.

     syscmd        usage: _s_y_s_c_m_d(_c_o_m_m_a_n_d)
                   executes the UNIX command given in the first
                   argument.  No value is returned.

     sysval        usage: _s_y_s_v_a_l()
                   is the return code from the last call to
                   _s_y_s_c_m_d.

     maketemp      usage: _m_a_k_e_t_e_m_p(_s_t_r_i_n_g)
                   fills in a string of XXXXXX in its argument
                   with the current process ID.

     m4exit        usage: _m_4_e_x_i_t([_e_x_i_t_c_o_d_e])
                   causes immediate exit from _m_4.  Argument 1, if
                   given, is the exit code; the default is 0.

     m4wrap        usage: _m_4_w_r_a_p(_m_4-_m_a_c_r_o-_o_r-_b_u_i_l_t-_i_n)
                   argument 1 will be pushed back at final EOF;
                   example: m4wrap(`dumptable()').

     errprint      usage: _e_r_r_p_r_i_n_t(_s_t_r [, _s_t_r, _s_t_r, ...])
                   prints its argument(s) on stderr. If there is
                   more than one argument, each argument is
                   separated by a space during the output.

     dumpdef       usage: _d_u_m_p_d_e_f([_n_a_m_e, _n_a_m_e, ...])
                   prints current names and definitions, for the
                   named items, or for all if no arguments are
                   given.

AUTHOR
     Ozan S. Yigit (oz)

BUGS
     Pd M4 is distributed at the source level, and does not
     require an expensive license agreement.




Printed 5/16/88            30 Aug 1987                          5






M4(local)           UNIX Programmer's Manual            M4(local)



     A sufficiently complex M4 macro set is about as readable as
     APL.

     All complex uses of M4 require the ability to program in
     deep recursion.  Previous lisp experience is recommended.

     Pd M4 is slower than V7 M4.

EXAMPLES
     The following macro program illustrates the type of things
     that can be done with M4.

          changequote(<,>) define(HASHVAL,99) dnl
          define(hash,<expr(str(substr($1,1),0)%HASHVAL)>) dnl
          define(str,
               <ifelse($1,",$2,
                    <str(substr(<$1>,1),<expr($2+'substr($1,0,1)')>)>)
               >) dnl
          define(KEYWORD,<$1,hash($1),>) dnl
          define(TSTART,
          <struct prehash {
               char *keyword;
               int   hashval;
          } keytab[] = {>) dnl
          define(TEND,<  "",0
          };>) dnl

     Thus a keyword table containing the keyword string and its
     pre-calculated hash value may be generated thus:

          TSTART
               KEYWORD("foo")
               KEYWORD("bar")
               KEYWORD("baz")
          TEND

     which will expand into:
          struct prehash {
               char *keyword;
               int   hashval;
          } keytab[] = {
               "foo",27,
               "bar",12,
               "baz",20,
               "",0
          };

     Presumably, such a table would speed up the installation of
     the keywords into a dynamic hash table. (Note that the above
     macro cannot be used with _M_4, since eval does not handle
     character constants.)




Printed 5/16/88            30 Aug 1987                          6






M4(local)           UNIX Programmer's Manual            M4(local)



SEE ALSO
     cc(1), m4(1), cpp(1).  _T_h_e _M_4 _M_a_c_r_o _P_r_o_c_e_s_s_o_r by B. W. Ker-
     nighan and D. M. Ritchie.




















































Printed 5/16/88            30 Aug 1987                          7



SHAR_EOF
if test 15241 -ne "`wc -c m4.man`"
then
echo shar: error transmitting m4.man '(should have been 15241 characters)'
fi
echo shar: extracting readme '(3304 characters)'
cat << \SHAR_EOF > readme
	What you have here is a completely PD implementation of
	M4. It was originally written for the GNU project. 
	This version was the last version before a major re-write 
	took place.

	Pd M4 is based on software tools macro, as described in the
	two tools books by Kernighan and Plauger. Although some
	serious changes have been made, this version inherits the basic
	design problems of the original, hence the ugliness of the
	underlying code. [GNU version of this processor is re-designed
	in a much cleaner fashion, and is expected to be out before 
	1988. GNU version also includes an extensive texinfo document.]

	PDness:

	This code *is* PD. You (public) have all the rights to the code. 
	[But this also means you (singular) do not have any *extra*
	rights to the code, hence it is impossible for you to restrict
	the use and distribution of this code in any way.]

	Dedication:

	This posting is a dedication to an old 750 that started out
	running 4.1BSD and had 1.5 meg, 1 dz11, and 2 Rk07 drives.
	It was named yetti [sic] by accident, and was managed by the
	author until its retirement few months ago. [the name yetti 
	now identifies a different machine]

	Distribution + misc:

	The distribution includes a small test suite, the sources and
	a man page. texinfo document is not included. The makefile is
	pretty simple. See the makefile for configuration options.
	Try "make time" for some timing comparisons between your un*x
	m4 and the pd m4. [It should be slighly slower than V7 m4, and
	slightly faster than SV m4]. Make sure to set MBIN to indicate
	the location of un*x m4. See the test suite (test.m4) for some
	additional comments about pd m4 vs un*x m4.

	Some thoughts:

	M4 is a neat macro processor but probably a bit outdated by
	now. It does not need gratuitous additions, or "features", but
	a complete re-write. As it stands, it is powerful enough for
	most macro processing needs. We have, for example, used it to
	build a configuration language for DECNET under VMS. It can
	be a handy software engineering tool under most circumstances,
	and can displace a lot of meaningless little hacks written in
	C, pascal or whatever. [See some net postings for references.]

	Suggestions for hacking:

	If you want to hack M4 further, you may wish to implement the
	SV m4 "trace" facility, and extended (5-char) Comment/Quote
	definitions. This version also needs some dynamicity for its
	data structures, and the ability to handle multiple file names
	in the command line. If you want to add "features", you may wish
	to first think about implementing the "feature" as an M4 macro.
	If you really want to elevate this processor into a more state-of
	the-art tool, than you should probably re-write it. [But I have
	already done that, so you may wish to wait for the GNU version to
	get a head start.]

	Feedback:

	If you have any important fixes and/or speed improvements,  I am
	much interested, since my new version inherits some code from this
	version. I am also interested in hearing about any unique applica-
	tions of M4. I am not interested in gratuitous hacks or "neat"
	kitchen-sink features. 

	Contact:

		Usenet: [decvax|ihnp4]!utzoo!yetti!oz || 
			    ...seismo!mnetor!yetti!oz
		Bitnet: oz@[yulibra|yuyetti].BITNET
		Phonet: [416] 736-5257 x 3976


	enjoy.	oz
SHAR_EOF
if test 3304 -ne "`wc -c readme`"
then
echo shar: error transmitting readme '(should have been 3304 characters)'
fi
echo shar: extracting readme.flax '(382 characters)'
cat << \SHAR_EOF > readme.flax
This is the port of M4 macro package to the amiga.
I just compiled the PD package and added some functions, also
claned up some code that wouldn't work on the amiga.
I haven't done too extensive tests, but it works fine with
the included testfiles. Anyway, if you find a bug, you have the 
source, so diffs will be enough.
The source included here compiles with just a few warnings
SHAR_EOF
if test 382 -ne "`wc -c readme.flax`"
then
echo shar: error transmitting readme.flax '(should have been 382 characters)'
fi
echo shar: extracting ack.m4 '(95 characters)'
cat << \SHAR_EOF > ack.m4
define(ack, `ifelse($1,0,incr($2),$2,0,`ack(DECR($1),1)',
`ack(DECR($1), ack($1,DECR($2)))')')
SHAR_EOF
if test 95 -ne "`wc -c ack.m4`"
then
echo shar: error transmitting ack.m4 '(should have been 95 characters)'
fi
echo shar: extracting hanoi.m4 '(189 characters)'
cat << \SHAR_EOF > hanoi.m4
define(hanoi, `trans(A, B, C, $1)')

define(moved,`move disk from $1 to $2
')

define(trans, `ifelse($4,1,`moved($1,$2)',
	`trans($1,$3,$2,DECR($4))moved($1,$2)trans($3,$2,$1,DECR($4))')')
SHAR_EOF
if test 189 -ne "`wc -c hanoi.m4`"
then
echo shar: error transmitting hanoi.m4 '(should have been 189 characters)'
fi
echo shar: extracting hash.m4 '(425 characters)'
cat << \SHAR_EOF > hash.m4
dnl	This probably will not run on any m4 that cannot
dnl	handle char constants in eval.
dnl
changequote(<,>) define(HASHVAL,99) dnl
define(hash,<eval(str(substr($1,1),0)%HASHVAL)>) dnl
define(str,
	<ifelse($1,",$2,
		<str(substr(<$1>,1),<eval($2+'substr($1,0,1)')>)>)
	>) dnl
define(KEYWORD,<$1,hash($1),>) dnl
define(TSTART,
<struct prehash {
	char *keyword;
	int   hashval;
} keytab[] = {>) dnl
define(TEND,<	"",0
};>) dnl
SHAR_EOF
if test 425 -ne "`wc -c hash.m4`"
then
echo shar: error transmitting hash.m4 '(should have been 425 characters)'
fi
echo shar: extracting sqroot.m4 '(238 characters)'
cat << \SHAR_EOF > sqroot.m4
define(square_root, 
	`ifelse(eval($1<0),1,negative-square-root,
			     `square_root_aux($1, 1, eval(($1+1)/2))')')
define(square_root_aux,
	`ifelse($3, $2, $3,
		$3, eval($1/$2), $3,
		`square_root_aux($1, $3, eval(($3+($1/$3))/2))')')
SHAR_EOF
if test 238 -ne "`wc -c sqroot.m4`"
then
echo shar: error transmitting sqroot.m4 '(should have been 238 characters)'
fi
echo shar: extracting string.m4 '(204 characters)'
cat << \SHAR_EOF > string.m4

define(string,`integer $1(len(substr($2,1)))
str($1,substr($2,1),0)
data $1(len(substr($2,1)))/EOS/
')

define(str,`ifelse($2,",,data $1(incr($3))/`LET'substr($2,0,1)/
`str($1,substr($2,1),incr($3))')')
SHAR_EOF
if test 204 -ne "`wc -c string.m4`"
then
echo shar: error transmitting string.m4 '(should have been 204 characters)'
fi
echo shar: extracting test.m4 '(7933 characters)'
cat << \SHAR_EOF > test.m4
#
# test file for mp (not comprehensive)
#
# v7 m4 does not have `decr'.
#
define(DECR,`eval($1-1)')
#
# include string macros
#
include(string.m4)
#
# create some fortrash strings for an even uglier language
#
string(TEXT, "text")
string(DATA, "data")
string(BEGIN, "begin")
string(END, "end")
string(IF, "if")
string(THEN, "then")
string(ELSE, "else")
string(CASE, "case")
string(REPEAT, "repeat")
string(WHILE, "while")
string(DEFAULT, "default")
string(UNTIL, "until")
string(FUNCTION, "function")
string(PROCEDURE, "procedure")
string(EXTERNAL, "external")
string(FORWARD, "forward")
string(TYPE, "type")
string(VAR, "var")
string(CONST, "const")
string(PROGRAM, "program")
string(INPUT, "input")
string(OUTPUT, "output")
#
divert(2)
diversion #1
divert(3)
diversion #2
divert(4)
diversion #3
divert(5)
diversion #4
divert(0)
define(abc,xxx)
ifdef(`abc',defined,undefined)
#
# v7 m4 does this wrong. The right output is 
# 	this is A vEry lon sEntEnCE
# see m4 documentation for translit.
#
translit(`this is a very long sentence', abcdefg, ABCDEF)
#
# include towers-of-hanoi
#
include(hanoi.m4)
#
# some reasonable set of disks
#
hanoi(6)
#
# include ackermann's function
#
include(ack.m4)
#
# something like (3,3) will blow away un*x m4.
#
ack(2,3)
#
# include a square_root function for fixed nums
#
include(sqroot.m4)
#
# some square roots.
#
square_root(15)
square_root(100)
square_root(-4)
square_root(21372)
#
# some textual material for enjoyment.
#
[taken from the 'Clemson University Computer Newsletter',
 September 1981, pp. 6-7]
     
I am a wizard in the magical Kingdom of Transformation and I
slay dragons for a living.  Actually, I am a systems programmer.
One of the problems with systems programming is explaining to
non-computer enthusiasts what that is.  All of the terms I use to
describe my job are totally meaningless to them.  Usually my response
to questions about my work is to say as little as possible.  For
instance, if someone asks what happened at work this week, I say
"Nothing much" and then I change the subject.
     
With the assistance of my brother, a mechanical engineer, I have devised
an analogy that everyone can understand.  The analogy describes the
"Kingdom of Transformation" where travelers wander and are magically
transformed.  This kingdom is the computer and the travelers are information.
The purpose of the computer is to change information to a more meaningful
forma.  The law of conservation applies here:  The computer never creates
and never intentionally destroys data.  With no further ado, let us travel
to the Kingdom of Transformation:
     
In a land far, far away, there is a magical kingdom called the Kingdom of
Transformation.  A king rules over this land and employs a Council of
Wizardry.  The main purpose of this kingdom is to provide a way for
neighboring kingdoms to transform citizens into more useful citizens.  This
is done by allowing the citizens to enter the kingdom at one of its ports
and to travel any of the many routes in the kingdom.  They are magically
transformed along the way.  The income of the Kingdom of Transformation
comes from the many toll roads within its boundaries.
     
The Kingdom of Transformation was created when several kingdoms got
together and discovered a mutual need for new talents and abilities for
citizens.  They employed CTK, Inc. (Creators of Transformation, Inc.) to
create this kingdom.  CTK designed the country, its transportation routes,
and its laws of transformation, and created the major highway system.
     
Hazards
=======
     
Because magic is not truly controllable, CTK invariably, but unknowingly,
creates dragons.  Dragons are huge fire-breathing beasts which sometimes
injure or kill travelers.  Fortunately, they do not travel, but always
remain near their den.
     
Other hazards also exist which are potentially harmful.  As the roads
become older and more weatherbeaten, pot-holes will develop, trees will
fall on travelers, etc.  CTK maintenance men are called to fix these
problems.
     
Wizards
=======
     
The wizards play a major role in creating and maintaining the kingdom but
get little credit for their work because it is performed secretly.  The
wizards do not wan the workers or travelers to learn their incantations
because many laws would be broken and chaos would result.
     
CTK's grand design is always general enough to be applicable in many
different situations.  As a result, it is often difficult to use.  The
first duty of the wizards is to tailor the transformation laws so as to be
more beneficial and easier to use in their particular environment.
     
After creation of the kingdom, a major duty of the wizards is to search for
and kill dragons.  If travelers do not return on time or if they return
injured, the ruler of the country contacts the wizards.  If the wizards
determine that the injury or death occurred due to the traveler's
negligence, they provide the traveler's country with additional warnings.
If not, they must determine if the cause was a road hazard or a dragon.  If
the suspect a road hazard, they call in a CTK maintenance man to locate the
hazard and to eliminate it, as in repairing the pothole in the road.  If
they think that cause was a dragon, then they must find and slay it.
     
The most difficult part of eliminating a dragon is finding it.  Sometimes
the wizard magically knows where the dragon's lair it, but often the wizard
must send another traveler along the same route and watch to see where he
disappears.  This sounds like a failsafe method for finding dragons (and a
suicide mission for thr traveler) but the second traveler does not always
disappear.  Some dragons eat any traveler who comes too close; others are
very picky.
     
The wizards may call in CTK who designed the highway system and
transformation laws to help devise a way to locate the dragon.  CTK also
helps provide the right spell or incantation to slay the dragon. (There is
no general spell to slay dragons; each dragon must be eliminated with a
different spell.)
     
Because neither CTK nor wizards are perfect, spells to not always work
correctly.  At best, nothing happens when the wrong spell is uttered.  At
worst, the dragon becomes a much larger dragon or multiplies into several
smaller ones.  In either case, new spells must be found.
     
If all existing dragons are quiet (i.e. have eaten sufficiently), wizards
have time to do other things.  They hide in castles and practice spells and
incatations.  They also devise shortcuts for travelers and new laws of
transformation.
     
Changes in the Kingdom
======================
     
As new transformation kingdoms are created and old ones are maintained,
CTK, Inc. is constantly learning new things.  It learns ways to avoid
creating some of the dragons that they have previously created.  It also
discovers new and better laws of transformation.  As a result, CTK will
periodically create a new grand design which is far better than the old.
The wizards determine when is a good time to implement this new design.
This is when the tourist season is slow or when no important travelers
(VIPs) are to arrive.  The kingdom must be closed for the actual
implementation and is leter reopened as a new and better place to go.
     
A final question you might ask is what happens when the number of tourists
becomes too great for the kingdom to handle in a reasonable period of time
(i.e., the tourist lines at the ports are too long).  The Kingdom of
Transformation has three options: (1) shorten the paths that a tourist must
travel, or (2) convince CTK to develop a faster breed of horses so that the
travelers can finish sooner, or (3) annex more territories so that the
kingdom can handle more travelers.
     
Thus ends the story of the Kingdom of Transformation.  I hope this has
explained my job to you:  I slay dragons for a living.

#
#should do an automatic undivert..
#
SHAR_EOF
if test 7933 -ne "`wc -c test.m4`"
then
echo shar: error transmitting test.m4 '(should have been 7933 characters)'
fi
#	End of shell archive
exit 0

ain@j.cc.purdue.edu (Patrick White) (06/01/88)

Submitted by:	kuhling!jonasf  (Jonas Flygare)
Summary:	unix m4 look-alike macro processor.
Poster Boy:	Patrick White	(ain@j.cc.purdue.edu)
Archive Name:	sources/amiga/volume5/m4.src.sh1.Z
tested.
 
NOTES:
   I undid the shar to undo the uuencoded compressed files, and to separate
the docs from everything else.
   I nroffed the docs so everybody gets a readable copy of the docs.
   A patch to some of the test files was included with the origional posting..
I applied the patch to the files and excluded the patch from this posting.
.
 
 
-- Pat White   (co-moderator comp.sources/binaries.amiga)
ARPA/UUCP: j.cc.purdue.edu!ain  BITNET: PATWHITE@PURCCVM  PHONE: (317) 743-8421
U.S.  Mail:  320 Brown St. apt. 406,    West Lafayette, IN 47906
 
========================================
 
#	This is a shell archive.
#	Remove everything above and including the cut line.
#	Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar:	Shell Archiver
#	Run the following text with /bin/sh to create:
#	manifest
#	makefile
#	m4.lnk
#	extr.h
#	mdef.h
#	eval.c
#	expr.c
#	getopt.c
#	look.c
#	main.c
#	mktemp.c
# This archive created: Mon May 16 09:27:04 1988
# By:	Patrick White (PUCC Land, USA)
echo shar: extracting manifest '(230 characters)'
cat << \SHAR_EOF > manifest
mdef.h	- definitions and structures
main.c	- this file: driver routines
eval.c	- general macro evaluator
serv.c	- service routines (doxxxx)
misc.c	- miscellaneous routines
expr.c	- expression parser
look.c	- hash table management
SHAR_EOF
if test 230 -ne "`wc -c manifest`"
then
echo shar: error transmitting manifest '(should have been 230 characters)'
fi
echo shar: extracting makefile '(1376 characters)'
cat << \SHAR_EOF > makefile
#
# pd m4	[oz]
#
#	-DEXTENDED 
#		if you like to get paste & spaste macros.
#	-DVOID 
#		if your C compiler does NOT support void.
#	-DGETOPT
#		if you STILL do not have getopt	in your library.
#		[This means your library is broken. Fix it.]
#	-DDUFFCP
#		if you do not have fast memcpy in your library.
#
CFLAGS = -DEXTENDED -DMYMKTMP -cw
DEST =  :
MANL = 	:
OBJS =  main.o eval.o serv.o look.o misc.o expr.o
CSRC =  main.c eval.c serv.c look.c misc.c expr.c
INCL =  mdef.h extr.h
MSRC =  ack.m4 hanoi.m4 hash.m4 sqroot.m4 string.m4 test.m4
DOCS =	README MANIFEST m4.1
LINKFILE = m4.lnk

MBIN = c:

m4: ${OBJS}
	@echo "loading m4.."
	@lc ${CFLAGS} ${OBJS}
	@blink with ${LINKFILE}
	@list m4

${OBJS}: ${INCL} 

install: m4
	copy ./m4 ${DEST}/m4
	copy ./m4.1 ${MANL}/m4.l

deinstall: 
	delete ${DEST}/m4
	delete ${MANL}/m4.l
time: m4
	@echo "timing comparisons.."
	@echo "un*x m4:"
	time ${MBIN}/m4 <test.m4 >unxm4.out
	@echo "pd m4:"
	time ./m4 <test.m4 >pdm4.out
	@echo "un*x m4:"
	time ${MBIN}/m4 <test.m4 >unxm4.out
	@echo "pd m4:"
	time ./m4 <test.m4 >pdm4.out
	@echo "un*x m4:"
	time ${MBIN}/m4 <test.m4 >unxm4.out
	@echo "pd m4:"
	time ./m4 <test.m4 >pdm4.out
	@echo "output comparisons.."
	-diff pdm4.out unxm4.out
	@rm -f pdm4.out unxm4.out
clean:
	delete #?.o core m4 #?.out
pack:
	shar -a makefile ${INCL} ${CSRC} >M4MAIN.SHAR
	shar -a ${MSRC} ${DOCS} >M4MSRC.SHAR
SHAR_EOF
if test 1376 -ne "`wc -c makefile`"
then
echo shar: error transmitting makefile '(should have been 1376 characters)'
fi
echo shar: extracting m4.lnk '(119 characters)'
cat << \SHAR_EOF > m4.lnk
FROM LIB:c.o+main.o+eval.o+serv.o+look.o+misc.o+expr.o+getopt.o+mktemp.o
TO m4
LIB LIB:lc.lib+LIB:amiga.lib
MAP m4.map
SHAR_EOF
if test 119 -ne "`wc -c m4.lnk`"
then
echo shar: error transmitting m4.lnk '(should have been 119 characters)'
fi
echo shar: extracting extr.h '(1150 characters)'
cat << \SHAR_EOF > extr.h
extern ndptr hashtab[];		/* hash table for macros etc.  */
extern char buf[];		/* push-back buffer	       */
extern char *bp;		/* first available character   */
extern char *endpbb;		/* end of push-back buffer     */
extern stae mstack[];		/* stack of m4 machine         */
extern char *ep;		/* first free char in strspace */
extern char *endest;		/* end of string space	       */
extern int sp; 			/* current m4  stack pointer   */
extern int fp; 			/* m4 call frame pointer       */
extern FILE *infile[];		/* input file stack (0=stdin)  */
extern FILE *outfile[];		/* diversion array(0=bitbucket)*/
extern FILE *active;		/* active output file pointer  */
extern char *m4temp;		/* filename for diversions     */
extern int ilevel;		/* input file stack pointer    */
extern int oindex;		/* diversion index..	       */
extern char *null;		/* as it says.. just a null..  */
extern char *m4wraps;		/* m4wrap string default..     */
extern char lquote;		/* left quote character  (`)   */
extern char rquote;		/* right quote character (')   */
extern char scommt;		/* start character for comment */
extern char ecommt;		/* end character for comment   */
SHAR_EOF
if test 1150 -ne "`wc -c extr.h`"
then
echo shar: error transmitting extr.h '(should have been 1150 characters)'
fi
echo shar: extracting mdef.h '(4970 characters)'
cat << \SHAR_EOF > mdef.h
/*
 * mdef.h
 * Facility: m4 macro processor
 * by: oz
 */
#define unix 1 /* should be here so i don't have to rewrite all the code. */

#ifndef unix
#define unix 0
#endif 

#ifndef vms
#define vms 0
#endif

#if vms

#include stdio
#include ctype
#include signal

#else 

#include <stdio.h>
#include <ctype.h>
#include <signal.h>
#include <stdlib.h>

#endif

/*
 *
 * m4 constants..
 *
 */
 
#define MACRTYPE        1
#define DEFITYPE        2
#define EXPRTYPE        3
#define SUBSTYPE        4
#define IFELTYPE        5
#define LENGTYPE        6
#define CHNQTYPE        7
#define SYSCTYPE        8
#define UNDFTYPE        9
#define INCLTYPE        10
#define SINCTYPE        11
#define PASTTYPE        12
#define SPASTYPE        13
#define INCRTYPE        14
#define IFDFTYPE        15
#define PUSDTYPE        16
#define POPDTYPE        17
#define SHIFTYPE        18
#define DECRTYPE        19
#define DIVRTYPE        20
#define UNDVTYPE        21
#define DIVNTYPE        22
#define MKTMTYPE        23
#define ERRPTYPE        24
#define M4WRTYPE        25
#define TRNLTYPE        26
#define DNLNTYPE        27
#define DUMPTYPE        28
#define CHNCTYPE        29
#define INDXTYPE        30
#define SYSVTYPE        31
#define EXITTYPE        32
#define DEFNTYPE        33
 
#define STATIC          128

/*
 * m4 special characters
 */
 
#define ARGFLAG         '$'
#define LPAREN          '('
#define RPAREN          ')'
#define LQUOTE          '`'
#define RQUOTE          '\''
#define COMMA           ','
#define SCOMMT          '#'
#define ECOMMT          '\n'

/*
 * definitions of diversion files. If the name of
 * the file is changed, adjust UNIQUE to point to the
 * wildcard (*) character in the filename.
 */

#if unix
#define DIVNAM  "/tmp/m4*XXXXXX"        /* unix diversion files    */
#define UNIQUE          7               /* unique char location    */
#else
#if vms
#define DIVNAM  "sys$login:m4*XXXXXX"   /* vms diversion files     */
#define UNIQUE          12              /* unique char location    */
#else
#if amiga
#define DIVNAM	"t:M4*XXXXXX"		/* msdos diversion files   */
#define	UNIQUE	    4			/* unique char location    */
#else
#define DIVNAM	"/M4*XXXXXX"		/* msdos diversion files   */
#define	UNIQUE	    3			/* unique char location    */
#endif
#endif
#endif

/*
 * other important constants
 */

#define EOS             (char) 0
#define MAXINP          10              /* maximum include files   */
#define MAXOUT          10              /* maximum # of diversions */
#define MAXSTR          512             /* maximum size of string  */
#define BUFSIZE         4096            /* size of pushback buffer */
#define STACKMAX        1024            /* size of call stack      */
#define STRSPMAX        4096            /* size of string space    */
#define MAXTOK          MAXSTR          /* maximum chars in a tokn */
#define HASHSIZE        199             /* maximum size of hashtab */
 
#define ALL             1
#define TOP             0
 
#define TRUE            1
#define FALSE           0
#define cycle           for(;;)

#ifdef VOID
#define void            int             /* define if void is void. */
#endif

/*
 * m4 data structures
 */
 
typedef struct ndblock *ndptr;
 
struct ndblock {                /* hastable structure         */
        char    *name;          /* entry name..               */
        char    *defn;          /* definition..               */
        int     type;           /* type of the entry..        */
        ndptr   nxtptr;         /* link to next entry..       */
};
 
#define nil     ((ndptr) 0)
 
struct keyblk {
        char    *knam;          /* keyword name */
        int     ktyp;           /* keyword type */
};

typedef union {			/* stack structure */
	int	sfra;		/* frame entry  */
	char 	*sstr;		/* string entry */
} stae;

/*
 * macros for readibility and/or speed
 *
 *      gpbc()  - get a possibly pushed-back character
 *      min()   - select the minimum of two elements
 *      pushf() - push a call frame entry onto stack
 *      pushs() - push a string pointer onto stack
 */
#define gpbc() 	 (bp > buf) ? *--bp : getc(infile[ilevel])
/* #define min(x,y) ((x > y) ? y : x) defined in stdio.h.. */
#define pushf(x) if (sp < STACKMAX) mstack[++sp].sfra = (x)
#define pushs(x) if (sp < STACKMAX) mstack[++sp].sstr = (x)

/*
 *	    .				   .
 *	|   .	|  <-- sp		|  .  |
 *	+-------+			+-----+
 *	| arg 3 ----------------------->| str |
 *	+-------+			|  .  |
 *	| arg 2 ---PREVEP-----+ 	   .
 *	+-------+	      |
 *	    .		      |		|     |
 *	+-------+	      | 	+-----+
 *	| plev	|  PARLEV     +-------->| str |
 *	+-------+			|  .  |
 *	| type	|  CALTYP		   .
 *	+-------+
 *	| prcf	---PREVFP--+
 *	+-------+  	   |
 *	|   .	|  PREVSP  |
 *	    .	   	   |
 *	+-------+	   |
 *	|	<----------+
 *	+-------+
 *
 */
#define PARLEV  (mstack[fp].sfra)
#define CALTYP  (mstack[fp-1].sfra)
#define PREVEP	(mstack[fp+3].sstr)
#define PREVSP	(fp-3)
#define PREVFP	(mstack[fp-2].sfra)
SHAR_EOF
if test 4970 -ne "`wc -c mdef.h`"
then
echo shar: error transmitting mdef.h '(should have been 4970 characters)'
fi
echo shar: extracting eval.c '(5714 characters)'
cat << \SHAR_EOF > eval.c
/*
 * eval.c
 * Facility: m4 macro processor
 * by: oz
 */

#include "mdef.h"
#include "extr.h"

extern ndptr lookup();
extern char *strsave();
extern char *mktemp();

/*
 * eval - evaluate built-in macros.
 *	  argc - number of elements in argv.
 *	  argv - element vector :
 *			argv[0] = definition of a user
 *				  macro or nil if built-in.
 *			argv[1] = name of the macro or
 *				  built-in.
 *			argv[2] = parameters to user-defined
 *			   .	  macro or built-in.
 *			   .
 *
 * Note that the minimum value for argc is 3. A call in the form
 * of macro-or-builtin() will result in:
 *			argv[0] = nullstr
 *			argv[1] = macro-or-builtin
 *			argv[2] = nullstr
 *
 */

int eval (argv, argc, td)
register char *argv[];
register int argc;
register int  td;
{
	register int c, n;
	static int sysval;

#ifdef DEBUG
	printf("argc = %d\n", argc);
	for (n = 0; n < argc; n++)
		printf("argv[%d] = %s\n", n, argv[n]);
#endif
	/*
	 * if argc == 3 and argv[2] is null,
	 * then we have macro-or-builtin() type call.
	 * We adjust argc to avoid further checking..
	 *
	 */
	if (argc == 3 && !*(argv[2]))
		argc--;

	switch (td & ~STATIC) {

	case DEFITYPE:
		if (argc > 2)
			dodefine(argv[2], (argc > 3) ? argv[3] : null);
		break;

	case PUSDTYPE:
		if (argc > 2)
			dopushdef(argv[2], (argc > 3) ? argv[3] : null);
		break;

	case DUMPTYPE:
		dodump(argv, argc);
		break;

	case EXPRTYPE:
		/*
		 * doexpr - evaluate arithmetic expression
		 *
		 */
		if (argc > 2)
			pbnum(expr(argv[2]));
		break;

	case IFELTYPE:
		if (argc > 4)
			doifelse(argv, argc);
		break;

	case IFDFTYPE:
		/*
		 * doifdef - select one of two alternatives based
		 *	     on the existence of another definition
		 */
		if (argc > 3) {
			if (lookup(argv[2]) != nil)
				pbstr(argv[3]);
			else if (argc > 4)
				pbstr(argv[4]);
		}
		break;

	case LENGTYPE:
		/*
		 * dolen - find the length of the argument
		 *
		 */
		if (argc > 2)
			pbnum((argc > 2) ? strlen(argv[2]) : 0);
		break;

	case INCRTYPE:
		/*
		 * doincr - increment the value of the argument
		 *
		 */
		if (argc > 2)
			pbnum(atoi(argv[2]) + 1);
		break;

	case DECRTYPE:
		/*
		 * dodecr - decrement the value of the argument
		 *
		 */
		if (argc > 2)
			pbnum(atoi(argv[2]) - 1);
		break;

#if unix || vms

	case SYSCTYPE:
		/*
		 * dosys - execute system command
		 *
		 */
		if (argc > 2)
			sysval = system(argv[2]);
		break;

	case SYSVTYPE:
		/*
		 * dosysval - return value of the last system call.
		 *
		 */
		pbnum(sysval);
		break;
#endif

	case INCLTYPE:
		if (argc > 2)
			if (!doincl(argv[2])) {
				fprintf(stderr,"m4: %s: ",argv[2]);
				error("cannot open for read.");
			}
		break;

	case SINCTYPE:
		if (argc > 2)
			(void) doincl(argv[2]);
		break;
#ifdef EXTENDED
	case PASTTYPE:
		if (argc > 2)
			if (!dopaste(argv[2])) {
				fprintf(stderr,"m4: %s: ",argv[2]);
				error("cannot open for read.");
			}
		break;

	case SPASTYPE:
		if (argc > 2)
			(void) dopaste(argv[2]);
		break;
#endif
	case CHNQTYPE:
		dochq(argv, argc);
		break;

	case CHNCTYPE:
		dochc(argv, argc);
		break;

	case SUBSTYPE:
		/*
		 * dosub - select substring
		 *
		 */
		if (argc > 3)
			dosub(argv,argc);
		break;

	case SHIFTYPE:
		/*
		 * doshift - push back all arguments except the
		 *	     first one (i.e. skip argv[2])
		 */
		if (argc > 3) {
			for (n = argc-1; n > 3; n--) {
				putback(rquote);
				pbstr(argv[n]);
				putback(lquote);
				putback(',');
			}
			putback(rquote);
			pbstr(argv[3]);
			putback(lquote);
		}
		break;

	case DIVRTYPE:
		if (argc > 2 && (n = atoi(argv[2])) != 0)
			dodiv(n);
		else {
			active = stdout;
			oindex = 0;
		}
		break;

	case UNDVTYPE:
		doundiv(argv, argc);
		break;

	case DIVNTYPE:
		/*
		 * dodivnum - return the number of current
		 * output diversion
		 *
		 */
		pbnum(oindex);
		break;

	case UNDFTYPE:
		/*
		 * doundefine - undefine a previously defined
		 *		macro(s) or m4 keyword(s).
		 */
		if (argc > 2)
			for (n = 2; n < argc; n++)
				remhash(argv[n], ALL);
		break;

	case POPDTYPE:
		/*
		 * dopopdef - remove the topmost definitions of
		 *	      macro(s) or m4 keyword(s).
		 */
		if (argc > 2)
			for (n = 2; n < argc; n++)
				remhash(argv[n], TOP);
		break;

	case MKTMTYPE:
		/*
		 * dotemp - create a temporary file
		 *
		 */
		if (argc > 2)
 			pbstr(mktemp(argv[2])); 

		break;

	case TRNLTYPE:
		/*
		 * dotranslit - replace all characters in the
		 *		source string that appears in
		 *		the "from" string with the corresponding
		 *		characters in the "to" string.
		 *
		 */
		if (argc > 3) {
			char temp[MAXTOK];
			if (argc > 4)
				map(temp, argv[2], argv[3], argv[4]);
			else
				map(temp, argv[2], argv[3], null);
			pbstr(temp);
		}
		else
		    if (argc > 2)
			pbstr(argv[2]);
		break;

	case INDXTYPE:
		/*
		 * doindex - find the index of the second argument
		 *	     string in the first argument string.
		 *	     -1 if not present.
		 */
		pbnum((argc > 3) ? indx(argv[2], argv[3]) : -1);
		break;

	case ERRPTYPE:
		/*
		 * doerrp - print the arguments to stderr file
		 *
		 */
		if (argc > 2) {
			for (n = 2; n < argc; n++)
				fprintf(stderr,"%s ", argv[n]);
			fprintf(stderr, "\n");
		}
		break;

	case DNLNTYPE:
		/*
		 * dodnl - eat-up-to and including newline
		 *
		 */
		while ((c = gpbc()) != '\n' && c != EOF)
			;
		break;

	case M4WRTYPE:
		/*
		 * dom4wrap - set up for wrap-up/wind-down activity
		 *
		 */
		m4wraps = (argc > 2) ? strsave(argv[2]) : null;
		break;

	case EXITTYPE:
		/*
		 * doexit - immediate exit from m4.
		 *
		 */
		exit((argc > 2) ? atoi(argv[2]) : 0);
		break;

	case DEFNTYPE:
		if (argc > 2)
			for (n = 2; n < argc; n++)
				dodefn(argv[n]);
		break;

	default:
		error("m4: major botch in eval.");
		break;
	}
}
SHAR_EOF
if test 5714 -ne "`wc -c eval.c`"
then
echo shar: error transmitting eval.c '(should have been 5714 characters)'
fi
echo shar: extracting expr.c '(11535 characters)'
cat << \SHAR_EOF > expr.c

/*
 *      expression evaluator: performs a standard recursive
 *      descent parse to evaluate any expression permissible
 *      within the following grammar:
 *
 *      expr    :       query EOS
 *      query   :       lor
 *              |       lor "?" query ":" query
 *      lor     :       land { "||" land }
 *      land    :       bor { "&&" bor }
 *      bor     :       bxor { "|" bxor }
 *      bxor    :       band { "^" band }
 *      band    :       eql { "&" eql }
 *      eql     :       relat { eqrel relat }
 *      relat   :       shift { rel shift }
 *      shift   :       primary { shop primary }
 *      primary :       term { addop term }
 *      term    :       unary { mulop unary }
 *      unary   :       factor
 *              |       unop unary
 *      factor  :       constant
 *              |       "(" query ")"
 *      constant:       num
 *              |       "'" CHAR "'"
 *      num     :       DIGIT
 *              |       DIGIT num
 *      shop    :       "<<"
 *              |       ">>"
 *      eqlrel  :       "="
 *              |       "=="
 *              |       "!="
 *      rel     :       "<"
 *              |       ">"
 *              |       "<="
 *              |       ">="
 *
 *
 *      This expression evaluator is lifted from a public-domain
 *      C Pre-Processor included with the DECUS C Compiler distribution.
 *      It is hacked somewhat to be suitable for m4.
 *
 *      Originally by:  Mike Lutz
 *                      Bob Harper
 */
 
#define TRUE    1
#define FALSE   0
#define EOS     (char) 0
#define EQL     0
#define NEQ     1
#define LSS     2
#define LEQ     3
#define GTR     4
#define GEQ     5
#define OCTAL   8
#define DECIMAL 10
 
static char *nxtch;     /* Parser scan pointer */
 
/*
 * For longjmp
 */
#include <setjmp.h>
static jmp_buf  expjump;
 
/*
 * macros:
 *
 *      ungetch - Put back the last character examined.
 *      getch   - return the next character from expr string.
 */
#define ungetch()       nxtch--
#define getch()         *nxtch++
 
expr(expbuf)
char *expbuf;
{
        register int rval;
 
        nxtch = expbuf;
        if (setjmp(expjump) != 0)
                return (FALSE);
        rval = query();
        if (skipws() == EOS)
                return(rval);
        experr("Ill-formed expression");
}
 
/*
 * query : lor | lor '?' query ':' query
 *
 */
query()
{
        register int bool, true_val, false_val;
 
        bool = lor();
        if (skipws() != '?') {
                ungetch();
                return(bool);
        }
 
        true_val = query();
        if (skipws() != ':')
                experr("Bad query");
 
        false_val = query();
        return(bool ? true_val : false_val);
}
 
/*
 * lor : land { '||' land }
 *
 */
lor()
{
        register int c, vl, vr;
 
        vl = land();
        while ((c = skipws()) == '|' && getch() == '|') {
                vr = land();
                vl = vl || vr;
        }
 
        if (c == '|')
                ungetch();
        ungetch();
        return(vl);
}
 
/*
 * land : bor { '&&' bor }
 *
 */
land()
{
        register int c, vl, vr;
 
        vl = bor();
        while ((c = skipws()) == '&' && getch() == '&') {
                vr = bor();
                vl = vl && vr;
        }
 
        if (c == '&')
                ungetch();
        ungetch();
        return(vl);
}
 
/*
 * bor : bxor { '|' bxor }
 *
 */
bor()
{
        register int vl, vr, c;
 
        vl = bxor();
        while ((c = skipws()) == '|' && getch() != '|') {
                ungetch();
                vr = bxor();
                vl |= vr;
        }
 
        if (c == '|')
                ungetch();
        ungetch();
        return(vl);
}
 
/*
 * bxor : band { '^' band }
 *
 */
bxor()
{
        register int vl, vr;
 
        vl = band();
        while (skipws() == '^') {
                vr = band();
                vl ^= vr;
        }
 
        ungetch();
        return(vl);
}
 
/*
 * band : eql { '&' eql }
 *
 */
band()
{
        register int vl, vr, c;
 
        vl = eql();
        while ((c = skipws()) == '&' && getch() != '&') {
                ungetch();
                vr = eql();
                vl &= vr;
        }
 
        if (c == '&')
                ungetch();
        ungetch();
        return(vl);
}
 
/*
 * eql : relat { eqrel relat }
 *
 */
eql()
{
        register int vl, vr, rel;
 
        vl = relat();
        while ((rel = geteql()) != -1) {
                vr = relat();
 
                switch (rel) {
 
                case EQL:
                        vl = (vl == vr);
                        break;
                case NEQ:
                        vl = (vl != vr);
                        break;
                }
        }
        return(vl);
}
 
/*
 * relat : shift { rel shift }
 *
 */
relat()
{
        register int vl, vr, rel;
 
        vl = shift();
        while ((rel = getrel()) != -1) {
 
                vr = shift();
                switch (rel) {
 
                case LEQ:
                        vl = (vl <= vr);
                        break;
                case LSS:
                        vl = (vl < vr);
                        break;
                case GTR:
                        vl = (vl > vr);
                        break;
                case GEQ:
                        vl = (vl >= vr);
                        break;
                }
        }
        return(vl);
}
 
/*
 * shift : primary { shop primary }
 *
 */
shift()
{
        register int vl, vr, c;
 
        vl = primary();
        while (((c = skipws()) == '<' || c == '>') && c == getch()) {
                vr = primary();
 
                if (c == '<')
                        vl <<= vr;
                else
                        vl >>= vr;
        }
 
        if (c == '<' || c == '>')
                ungetch();
        ungetch();
        return(vl);
}
 
/*
 * primary : term { addop term }
 *
 */
primary()
{
        register int c, vl, vr;
 
        vl = term();
        while ((c = skipws()) == '+' || c == '-') {
                vr = term();
                if (c == '+')
                        vl += vr;
                else
                        vl -= vr;
        }
 
        ungetch();
        return(vl);
}
 
/*
 * <term> := <unary> { <mulop> <unary> }
 *
 */
term()
{
        register int c, vl, vr;
 
        vl = unary();
        while ((c = skipws()) == '*' || c == '/' || c == '%') {
                vr = unary();
 
                switch (c) {
                case '*':
                        vl *= vr;
                        break;
                case '/':
                        vl /= vr;
                        break;
                case '%':
                        vl %= vr;
                        break;
                }
        }
        ungetch();
        return(vl);
}
 
/*
 * unary : factor | unop unary
 *
 */
unary()
{
        register int val, c;
 
        if ((c = skipws()) == '!' || c == '~' || c == '-') {
                val = unary();
 
                switch (c) {
                case '!':
                        return(! val);
                case '~':
                        return(~ val);
                case '-':
                        return(- val);
                }
        }
 
        ungetch();
        return(factor());
}
 
/*
 * factor : constant | '(' query ')'
 *
 */
factor()
{
        register int val;
 
        if (skipws() == '(') {
                val = query();
                if (skipws() != ')')
                        experr("Bad factor");
                return(val);
        }
 
        ungetch();
        return(constant());
}
 
/*
 * constant: num | 'char'
 *
 */
constant()
{
        /*
         * Note: constant() handles multi-byte constants
         */
 
        register int    i;
        register int    value;
        register char   c;
        int             v[sizeof (int)];
 
        if (skipws() != '\'') {
                ungetch();
                return(num());
        }
        for (i = 0; i < sizeof(int); i++) {
                if ((c = getch()) == '\'') {
                        ungetch();
                        break;
                }
                if (c == '\\') {
                        switch (c = getch()) {
                        case '0':
                        case '1':
                        case '2':
                        case '3':
                        case '4':
                        case '5':
                        case '6':
                        case '7':
                                ungetch();
                                c = num();
                                break;
                        case 'n':
                                c = 012;
                                break;
                        case 'r':
                                c = 015;
                                break;
                        case 't':
                                c = 011;
                                break;
                        case 'b':
                                c = 010;
                                break;
                        case 'f':
                                c = 014;
                                break;
                        }
                }
                v[i] = c;
        }
        if (i == 0 || getch() != '\'')
                experr("Illegal character constant");
        for (value = 0; --i >= 0;) {
                value <<= 8;
                value += v[i];
        }
        return(value);
}
 
/*
 * num : digit | num digit
 *
 */
num()
{
        register int rval, c, base;
        int ndig;
 
        base = ((c = skipws()) == '0') ? OCTAL : DECIMAL;
        rval = 0;
        ndig = 0;
        while (c >= '0' && c <= (base == OCTAL ? '7' : '9')) {
                rval *= base;
                rval += (c - '0');
                c = getch();
                ndig++;
        }
        ungetch();
        if (ndig)
                return(rval);
        experr("Bad constant");
}
 
/*
 * eqlrel : '=' | '==' | '!='
 *
 */
geteql()
{
        register int c1, c2;
 
        c1 = skipws();
        c2 = getch();
 
        switch (c1) {
 
        case '=':
                if (c2 != '=')
                        ungetch();
                return(EQL);
 
        case '!':
                if (c2 == '=')
                        return(NEQ);
                ungetch();
                ungetch();
                return(-1);
 
        default:
                ungetch();
                ungetch();
                return(-1);
        }
}
 
/*
 * rel : '<' | '>' | '<=' | '>='
 *
 */
getrel()
{
        register int c1, c2;
 
        c1 = skipws();
        c2 = getch();
 
        switch (c1) {
 
        case '<':
                if (c2 == '=')
                        return(LEQ);
                ungetch();
                return(LSS);
 
        case '>':
                if (c2 == '=')
                        return(GEQ);
                ungetch();
                return(GTR);
 
        default:
                ungetch();
                ungetch();
                return(-1);
        }
}
 
/*
 * Skip over any white space and return terminating char.
 */
skipws()
{
        register char c;
 
        while ((c = getch()) <= ' ' && c > EOS)
                ;
        return(c);
}
 
/*
 * Error handler - resets environment to eval(), prints an error,
 * and returns FALSE.
 */
int experr(msg)
char *msg;
{
        printf("mp: %s\n",msg);
        longjmp(expjump, -1);          /* Force eval() to return FALSE */
}
SHAR_EOF
if test 11535 -ne "`wc -c expr.c`"
then
echo shar: error transmitting expr.c '(should have been 11535 characters)'
fi
echo shar: extracting getopt.c '(2825 characters)'
cat << \SHAR_EOF > getopt.c
/*  getopt.h - Get next option letter from argument vector.
               v1.1  12-Dec-1987  aklevin
*/

#define GETOPT_H

#ifndef _STDIO_H
#include <stdio.h>
#endif

/*  optarg points to an option's argument (if any).
    optind holds the index of the next argument vector element to parse.
     Once all options have been parsed, points to the first non-option argument.
	 [If (optind > argc) then there are no more arguments].
    opterr, if set to 0 will suppress getopt's error messages (default is 1).
    optopt, while not usually documented, is used here to return the actual
     option character found, even when getopt itself returns '?'.
*/
char *optarg;
int optind=1, opterr=1, optopt;

int
getopt(argc, argv, optstring)
int argc;
char *argv[], *optstring;
{

int any_more, i, result;
static int opthold, optsub=1;

/*  Reset optarg upon entry  */
*optarg = '\0';

/*  Reset optsub if caller has changed optind.  */
if (optind != opthold) optsub = 1;

/*  Look at each element of the argument vector still unparsed.  */
for ( ; optind < argc; optind++) {
	/*  Done if a non-option argument or single dash is reached.
		However, don't skip over said argument.  */
	if (argv[optind][0] != '-' || argv[optind][1] == '\0') break;

	/*  Got an option.  */

	/*  Done if "--" is reached.  Skip over it, too.  */
	if (argv[optind][1] == '-') {
		optind++;
		break;
	}

	/*  Look at each character in optstring.  */
	for (i=0; i < strlen(optstring); i++) {
		if ( (optopt = argv[optind][optsub]) != optstring[i]) continue;

		/*  Got a match.  */

		/*  Are there any more chars in this option?  e.g. `-abc'  */
		any_more = strlen(argv[optind])-optsub-1;

		/*  Does this option require an argument?  */
		if (optstring[i+1] == ':') {

			/*  Yes.  If this is the last argument, complain.  */
			if (optind == argc-1 && !any_more) {
				if (opterr) fprintf(stderr, "%s: `-%c' option requires an argument.\n", argv[0], optopt);
				optind++;
				result='?';
				goto leave;
			} /* end if (opt */

			/*  Qualifier is either rest of this argument (if any)
			    or next argument.  */
			else {
				if (!any_more) optarg = argv[++optind];
				else optarg = &argv[optind][optsub+1];
				optind++;
				optsub=1;
			} /* end else */
		} /* end if (opt */
		else {
			/*  No argument; just adjust indices.  */
			/*  Advance to next argument.  */
			if (!any_more) {
				optind++;
				optsub=1;
			} /* end if (! */
			/*  Advance to next character.  */
			else optsub++;
		} /* end else */
		result=optopt;
		goto leave;
	} /* end for (i=0 */
if (opterr) fprintf(stderr, "%s: Unrecognized option `-%c'.\n", argv[0], optopt);
if (strlen(argv[optind])-optsub-1) optsub++;
else {
	optind++;
	optsub=1;
}
result='?';
goto leave;
} /* end for ( ; */
result=EOF;
leave:
	opthold = optind;
	return(result);
} /* end getopt() */

SHAR_EOF
if test 2825 -ne "`wc -c getopt.c`"
then
echo shar: error transmitting getopt.c '(should have been 2825 characters)'
fi
echo shar: extracting look.c '(1649 characters)'
cat << \SHAR_EOF > look.c
/*
 * look.c
 * Facility: m4 macro processor
 * by: oz
 */

#include "mdef.h"
#include "extr.h"

extern char *strsave();

/*
 *  hash - compute hash value using the proverbial
 *	   hashing function. Taken from K&R.
 */
hash (name)
register char *name;
{
	register int h = 0;
	while (*name)
		h += *name++;
	return (h % HASHSIZE);
}

/*
 * lookup - find name in the hash table
 *
 */
ndptr lookup(name)
char *name;
{
	register ndptr p;

	for (p = hashtab[hash(name)]; p != nil; p = p->nxtptr)
		if (strcmp(name, p->name) == 0)
			break;
	return (p);
}

/*
 * addent - hash and create an entry in the hash
 *	    table. The new entry is added in front
 *	    of a hash bucket.
 */
ndptr addent(name)
char *name;
{
	register int h;
	ndptr p;

	h = hash(name);
	if ((p = (ndptr) malloc(sizeof(struct ndblock))) != NULL) {
		p->nxtptr = hashtab[h];
		hashtab[h] = p;
		p->name = strsave(name);
	}
	else
		error("m4: no more memory.");
	return p;
}

/*
 * remhash - remove an entry from the hashtable
 *
 */
int remhash(name, all)
char *name;
int all;
{
	register int h;
	register ndptr xp, tp, mp;

	h = hash(name);
	mp = hashtab[h];
	tp = nil;
	while (mp != nil) {
		if (strcmp(mp->name, name) == 0) {
			mp = mp->nxtptr;
			if (tp == nil) {
				freent(hashtab[h]);
				hashtab[h] = mp;
			}
			else {
				xp = tp->nxtptr;
				tp->nxtptr = mp;
				freent(xp);
			}
			if (!all)
				break;
		}
		else {
			tp = mp;
			mp = mp->nxtptr;
		}
	}
}

/*
 * freent - free a hashtable information block
 *
 */
int freent(p)
ndptr p;
{
	if (!(p->type & STATIC)) {
		free((char *)p->name);
		if (p->defn != null)
			free((char *)p->defn);
	}
	free((char *)p);
}

SHAR_EOF
if test 1649 -ne "`wc -c look.c`"
then
echo shar: error transmitting look.c '(should have been 1649 characters)'
fi
echo shar: extracting main.c '(11175 characters)'
cat << \SHAR_EOF > main.c
/*
 * main.c
 * Facility: m4 macro processor
 * by: oz
 */

#include "mdef.h"

/*
 * m4 - macro processor
 *
 * PD m4 is based on the macro tool distributed with the software 
 * tools (VOS) package, and described in the "SOFTWARE TOOLS" and 
 * "SOFTWARE TOOLS IN PASCAL" books. It has been expanded to include 
 * most of the command set of SysV m4, the standard UN*X macro processor.
 *
 * Since both PD m4 and UN*X m4 are based on SOFTWARE TOOLS macro,
 * there may be certain implementation similarities between
 * the two. The PD m4 was produced without ANY references to m4
 * sources.
 *
 * References:
 *
 *	Software Tools distribution: macro
 *
 *	Kernighan, Brian W. and P. J. Plauger, SOFTWARE
 *	TOOLS IN PASCAL, Addison-Wesley, Mass. 1981
 *
 *	Kernighan, Brian W. and P. J. Plauger, SOFTWARE
 *	TOOLS, Addison-Wesley, Mass. 1976
 *
 *	Kernighan, Brian W. and Dennis M. Ritchie,
 *	THE M4 MACRO PROCESSOR, Unix Programmer's Manual,
 *	Seventh Edition, Vol. 2, Bell Telephone Labs, 1979
 *
 *	System V man page for M4
 *
 * Modification History:
 *
 * Jan 28 1986 Oz	Break the whole thing into little
 *			pieces, for easier (?) maintenance.
 *
 * Dec 12 1985 Oz	Optimize the code, try to squeeze
 *			few microseconds out..
 *
 * Dec 05 1985 Oz	Add getopt interface, define (-D),
 *			undefine (-U) options.
 *
 * Oct 21 1985 Oz	Clean up various bugs, add comment handling.
 *
 * June 7 1985 Oz	Add some of SysV m4 stuff (m4wrap, pushdef,
 *			popdef, decr, shift etc.).
 *
 * June 5 1985 Oz	Initial cut.
 *
 * Implementation Notes:
 *
 * [1]	PD m4 uses a different (and simpler) stack mechanism than the one 
 *	described in Software Tools and Software Tools in Pascal books. 
 *	The triple stack nonsense is replaced with a single stack containing 
 *	the call frames and the arguments. Each frame is back-linked to a 
 * 	previous stack frame, which enables us to rewind the stack after 
 * 	each nested call is completed. Each argument is a character pointer 
 *	to the beginning of the argument string within the string space.
 *	The only exceptions to this are (*) arg 0 and arg 1, which are
 * 	the macro definition and macro name strings, stored dynamically
 *	for the hash table.
 *
 *	    .					   .
 *	|   .	|  <-- sp			|  .  |
 *	+-------+				+-----+
 *	| arg 3 ------------------------------->| str |
 *	+-------+				|  .  |
 *	| arg 2 --------------+ 		   .
 *	+-------+	      |
 *	    *		      |			|     |
 *	+-------+	      | 		+-----+
 *	| plev	|  <-- fp     +---------------->| str |
 *	+-------+				|  .  |
 *	| type	|				   .
 *	+-------+
 *	| prcf	-----------+		plev: paren level
 *	+-------+  	   |		type: call type
 *	|   .	| 	   |		prcf: prev. call frame
 *	    .	   	   |
 *	+-------+	   |
 *	|	<----------+
 *	+-------+
 *
 * [2]	We have three types of null values:
 *
 *		nil  - nodeblock pointer type 0
 *		null - null string ("")
 *		NULL - Stdio-defined NULL
 *
 */

#ifdef MYMKTMP
int mytmpnum=000000;		/* used in mktemp()	       */
#endif

ndptr hashtab[HASHSIZE];	/* hash table for macros etc.  */
char buf[BUFSIZE];		/* push-back buffer	       */
char *bp = buf; 		/* first available character   */
char *endpbb = buf+BUFSIZE;	/* end of push-back buffer     */
stae mstack[STACKMAX+1]; 	/* stack of m4 machine         */
char strspace[STRSPMAX+1];	/* string space for evaluation */
char *ep = strspace;		/* first free char in strspace */
char *endest= strspace+STRSPMAX;/* end of string space	       */
int sp; 			/* current m4  stack pointer   */
int fp; 			/* m4 call frame pointer       */
FILE *infile[MAXINP];		/* input file stack (0=stdin)  */
FILE *outfile[MAXOUT];		/* diversion array(0=bitbucket)*/
FILE *active;			/* active output file pointer  */
char *m4temp;			/* filename for diversions     */
int ilevel = 0; 		/* input file stack pointer    */
int oindex = 0; 		/* diversion index..	       */
char *null = "";                /* as it says.. just a null..  */
char *m4wraps = "";             /* m4wrap string default..     */
char lquote = LQUOTE;		/* left quote character  (`)   */
char rquote = RQUOTE;		/* right quote character (')   */
char scommt = SCOMMT;		/* start character for comment */
char ecommt = ECOMMT;		/* end character for comment   */
struct keyblk keywrds[] = {	/* m4 keywords to be installed */
	"include",      INCLTYPE,
	"sinclude",     SINCTYPE,
	"define",       DEFITYPE,
	"defn",         DEFNTYPE,
	"divert",       DIVRTYPE,
	"expr",         EXPRTYPE,
	"eval",         EXPRTYPE,
	"substr",       SUBSTYPE,
	"ifelse",       IFELTYPE,
	"ifdef",        IFDFTYPE,
	"len",          LENGTYPE,
	"incr",         INCRTYPE,
	"decr",         DECRTYPE,
	"dnl",          DNLNTYPE,
	"changequote",  CHNQTYPE,
	"changecom",    CHNCTYPE,
	"index",        INDXTYPE,
#ifdef EXTENDED
	"paste",        PASTTYPE,
	"spaste",       SPASTYPE,
#endif
	"popdef",       POPDTYPE,
	"pushdef",      PUSDTYPE,
	"dumpdef",      DUMPTYPE,
	"shift",        SHIFTYPE,
	"translit",     TRNLTYPE,
	"undefine",     UNDFTYPE,
	"undivert",     UNDVTYPE,
	"divnum",       DIVNTYPE,
	"maketemp",     MKTMTYPE,
	"errprint",     ERRPTYPE,
	"m4wrap",       M4WRTYPE,
	"m4exit",       EXITTYPE,
#if unix || vms
	"syscmd",       SYSCTYPE,
	"sysval",       SYSVTYPE,
#endif
#if unix
	"unix",         MACRTYPE,
#else
#if vms
	"vms",          MACRTYPE,
#endif
#endif
};

#define MAXKEYS	(sizeof(keywrds)/sizeof(struct keyblk))

extern ndptr lookup();
extern ndptr addent();
extern int onintr();

extern char *malloc();
extern char *mktemp();

extern int optind;
extern char *optarg;

void main(argc,argv)
char *argv[];
{
	register int c;
	register int n;
	char *p;

	if (signal(SIGINT, SIG_IGN) != SIG_IGN)
		signal(SIGINT, onintr);
#ifdef NONZEROPAGES
	initm4();
#endif
	initkwds();

	while ((c = getopt(argc, argv, "tD:U:o:")) != EOF)
		switch(c) {

		case 'D':               /* define something..*/
			for (p = optarg; *p; p++)
				if (*p == '=')
					break;
			if (*p)
				*p++ = EOS;
			dodefine(optarg, p);
			break;
		case 'U':               /* undefine...       */
			remhash(optarg, TOP);
			break;
		case 'o':		/* specific output   */
		case '?':
		default:
			usage();
		}

	infile[0] = stdin;		/* default input (naturally) */
	active = stdout;		/* default active output     */
 	m4temp = mktemp(DIVNAM);	/* filename for diversions   */

	sp = -1;			/* stack pointer initialized */
	fp = 0; 			/* frame pointer initialized */

	macro();			/* get some work done here   */

	if (*m4wraps) { 		/* anything for rundown ??   */
		ilevel = 0;		/* in case m4wrap includes.. */
		putback(EOF);		/* eof is a must !!	     */
		pbstr(m4wraps); 	/* user-defined wrapup act   */
		macro();		/* last will and testament   */
	}
	else				/* default wrap-up: undivert */
		for (n = 1; n < MAXOUT; n++)
			if (outfile[n] != NULL)
				getdiv(n);

					/* remove bitbucket if used  */
	if (outfile[0] != NULL) {
		(void) fclose(outfile[0]);
		m4temp[UNIQUE] = '0';
#if vms
		(void) remove(m4temp);
#else
		(void) unlink(m4temp);
#endif
	}

	exit(0);
}

ndptr inspect();	/* forward ... */

/*
 * macro - the work horse..
 *
 */
int macro() {
	char token[MAXTOK];
	register char *s;
	register int t, l;
	register ndptr p;
	register int  nlpar;

	cycle {
		if ((t = gpbc()) == '_' || isalpha(t)) {
			putback(t);
			if ((p = inspect(s = token)) == nil) {
				if (sp < 0)
					while (*s)
						putc(*s++, active);
				else
					while (*s)
						chrsave(*s++);
			}
			else {
		/*
		 * real thing.. First build a call frame:
		 *
		 */
				pushf(fp);	/* previous call frm */
				pushf(p->type); /* type of the call  */
				pushf(0);	/* parenthesis level */
				fp = sp;	/* new frame pointer */
		/*
		 * now push the string arguments:
		 *
		 */
				pushs(p->defn);	      /* defn string */
				pushs(p->name);	      /* macro name  */
				pushs(ep);	      /* start next..*/

				putback(l = gpbc());
				if (l != LPAREN)  {   /* add bracks  */
					putback(RPAREN);
					putback(LPAREN);
				}
			}
		}
		else if (t == EOF) {
			if (sp > -1)
				error("m4: unexpected end of input");
			if (--ilevel < 0)
				break;			/* all done thanks.. */
			(void) fclose(infile[ilevel+1]);
			continue;
		}
	/*
	 * non-alpha single-char token seen..
	 * [the order of else if .. stmts is
	 * important.]
	 *
	 */
		else if (t == lquote) { 		/* strip quotes */
			nlpar = 1;
			do {
				if ((l = gpbc()) == rquote)
					nlpar--;
				else if (l == lquote)
					nlpar++;
				else if (l == EOF)
					error("m4: missing right quote");
				if (nlpar > 0) {
					if (sp < 0)
						putc(l, active);
					else
						chrsave(l);
				}
			}
			while (nlpar != 0);
		}

		else if (sp < 0) {		/* not in a macro at all */
			if (t == scommt) {	/* comment handling here */
				putc(t, active);
				while ((t = gpbc()) != ecommt)
					putc(t, active);
			}
			putc(t, active);	/* output directly..	 */
		}

		else switch(t) {

		case LPAREN:
			if (PARLEV > 0)
				chrsave(t);
			while (isspace(l = gpbc()))
				;		/* skip blank, tab, nl.. */
			putback(l);
			PARLEV++;
			break;

		case RPAREN:
			if (--PARLEV > 0)
				chrsave(t);
			else {			/* end of argument list */
				chrsave(EOS);

				if (sp == STACKMAX)
					error("m4: internal stack overflow");

				if (CALTYP == MACRTYPE)
					expand(mstack+fp+1, sp-fp);
				else
					eval(mstack+fp+1, sp-fp, CALTYP);

				ep = PREVEP;	/* flush strspace */
				sp = PREVSP;	/* previous sp..  */
				fp = PREVFP;	/* rewind stack...*/
			}
			break;

		case COMMA:
			if (PARLEV == 1)	{
				chrsave(EOS);		/* new argument   */
				while (isspace(l = gpbc()))
					;
				putback(l);
				pushs(ep);
			}
			break;
		default:
			chrsave(t);			/* stack the char */
			break;
		}
	}
}


/*
 * build an input token..
 * consider only those starting with _ or A-Za-z. This is a
 * combo with lookup to speed things up.
 */
ndptr
inspect(tp) 
register char *tp;
{
	register int h = 0;
	register char c;
	register char *name = tp;
	register char *etp = tp+MAXTOK;
	register ndptr p;

	while (tp < etp && (isalnum(c = gpbc()) || c == '_'))
		h += (*tp++ = c);
	putback(c);
	if (tp == etp)
		error("m4: token too long");
	*tp = EOS;
	for (p = hashtab[h%HASHSIZE]; p != nil; p = p->nxtptr)
		if (strcmp(name, p->name) == 0)
			break;
	return(p);
}

#ifdef NONZEROPAGES
/*
 * initm4 - initialize various tables. Useful only if your system 
 * does not know anything about demand-zero pages.
 *
 */
initm4()
{
	register int i;

	for (i = 0; i < HASHSIZE; i++)
		hashtab[i] = nil;
	for (i = 0; i < MAXOUT; i++)
		outfile[i] = NULL;
}
#endif

/*
 * initkwds - initialise m4 keywords as fast as possible. 
 * This very similar to install, but without certain overheads,
 * such as calling lookup. Malloc is not used for storing the 
 * keyword strings, since we simply use the static  pointers
 * within keywrds block. We also assume that there is enough memory 
 * to at least install the keywords (i.e. malloc won't fail).
 *
 */

int initkwds() {
	register int i;
	register int h;
	register ndptr p;

	for (i = 0; i < MAXKEYS; i++) {
		h = hash(keywrds[i].knam);
		p = (ndptr) malloc(sizeof(struct ndblock));
		p->nxtptr = hashtab[h];
		hashtab[h] = p;
		p->name = keywrds[i].knam;
		p->defn = null;
		p->type = keywrds[i].ktyp | STATIC;
	}
}
SHAR_EOF
if test 11175 -ne "`wc -c main.c`"
then
echo shar: error transmitting main.c '(should have been 11175 characters)'
fi
echo shar: extracting mktemp.c '(513 characters)'
cat << \SHAR_EOF > mktemp.c
#include <stdio.h>

/* mktemp(0 shamelessly swiped off our vax, didn't find */
/* a (c) anywhere on this piece of code..               */


char *
mktemp(as)
char *as;
{
	register char *s;
	register int tmp;
	register i;
	extern int mytmpnum;

loop:	tmp = mytmpnum%100000;
	s = as;
	while (*s++)
		;
	s--;
	while (*--s == 'X') {
		*s = (tmp%10) + '0';
		tmp /= 10;
	}
	s++;
	i = 'a';
	while (access(as, 0) != -1) {
		if (i=='z')
			{
			mytmpnum+=1;
			goto loop;
			}
		*s = i++;
	}
	mytmpnum+=1;
	return(as);
}
SHAR_EOF
if test 513 -ne "`wc -c mktemp.c`"
then
echo shar: error transmitting mktemp.c '(should have been 513 characters)'
fi
#	End of shell archive
exit 0

ain@j.cc.purdue.edu (Patrick White) (06/01/88)

Submitted by:	kuhling!jonasf  (Jonas Flygare)
Summary:	unix m4 look-alike macro processor.
Poster Boy:	Patrick White	(ain@j.cc.purdue.edu)
Archive Name:	sources/amiga/volume5/m4.src.sh2.Z
tested.
 
NOTES:
   I undid the shar to undo the uuencoded compressed files, and to separate
the docs from everything else.
   I nroffed the docs so everybody gets a readable copy of the docs.
   A patch to some of the test files was included with the origional posting..
I applied the patch to the files and excluded the patch from this posting.
.
 
 
-- Pat White   (co-moderator comp.sources/binaries.amiga)
ARPA/UUCP: j.cc.purdue.edu!ain  BITNET: PATWHITE@PURCCVM  PHONE: (317) 743-8421
U.S.  Mail:  320 Brown St. apt. 406,    West Lafayette, IN 47906
 
========================================
 
#	This is a shell archive.
#	Remove everything above and including the cut line.
#	Then run the rest of the file through sh.
#----cut here-----cut here-----cut here-----cut here----#
#!/bin/sh
# shar:	Shell Archiver
#	Run the following text with /bin/sh to create:
#	serv.c
#	main.c.orig
#	m4.1
# This archive created: Mon May 16 09:27:49 1988
# By:	Patrick White (PUCC Land, USA)
echo shar: extracting serv.c '(11602 characters)'
cat << \SHAR_EOF > serv.c
/*
 * serv.c
 * Facility: m4 macro processor
 * by: oz
 */
 
#include "mdef.h"
#include "extr.h" 

extern ndptr lookup();
extern ndptr addent();
extern char  *strsave();
 
char *dumpfmt = "`%s'\t`%s'\n"; /* format string for dumpdef   */
 
/*
 * expand - user-defined macro expansion
 *
 */
int expand(argv, argc)
register char *argv[];
register int argc;
{
        register char *t;
        register char *p;
        register int  n;
        register int  argno;
 
        t = argv[0];    /* defn string as a whole */
        p = t;
        while (*p)
                p++;
        p--;            /* last character of defn */
        while (p > t) {
                if (*(p-1) != ARGFLAG)
                        putback(*p);
                else {
                        switch (*p) {
 
                        case '#':
                                pbnum(argc-2);
                                break;
                        case '0':
                        case '1':
                        case '2':
                        case '3':
                        case '4':
                        case '5':
                        case '6':
                        case '7':
                        case '8':
                        case '9':
                                if ((argno = *p - '0') < argc-1)
                                        pbstr(argv[argno+1]);
                                break;
                        case '*':
                                for (n = argc - 1; n > 2; n--) {
                                        pbstr(argv[n]);
                                        putback(',');
                                }
                                pbstr(argv[2]);
                                break;
                        default :
                                putback(*p);
                                break;
                        }
                        p--;
                }
                p--;
        }
        if (p == t)         /* do last character */
                putback(*p);
}
 
/*
 * dodefine - install definition in the table
 *
 */
int dodefine(name, defn)
register char *name;
register char *defn;
{
        register ndptr p;
 
        if (!*name)
                error("m4: null definition.");
        if (strcmp(name, defn) == 0)
                error("m4: recursive definition.");
        if ((p = lookup(name)) == nil)
                p = addent(name);
        else if (p->defn != null)
                free(p->defn);
        if (!*defn)
                p->defn = null;
        else
                p->defn = strsave(defn);
        p->type = MACRTYPE;
}
 
/*
 * dodefn - push back a quoted definition of
 *      the given name.
 */
 
int dodefn(name)
char *name;
{
        register ndptr p;
 
        if ((p = lookup(name)) != nil && p->defn != null) {
                putback(rquote);
                pbstr(p->defn);
                putback(lquote);
        }
}
     
/*
 * dopushdef - install a definition in the hash table
 *      without removing a previous definition. Since
 *      each new entry is entered in *front* of the
 *      hash bucket, it hides a previous definition from
 *      lookup.
 */
int dopushdef(name, defn)
register char *name;
register char *defn;
{
        register ndptr p;
 
        if (!*name)
                error("m4: null definition");
        if (strcmp(name, defn) == 0)
                error("m4: recursive definition.");
        p = addent(name);
        if (!*defn)
                p->defn = null;
        else
                p->defn = strsave(defn);
        p->type = MACRTYPE;
}
 
/*
 * dodumpdef - dump the specified definitions in the hash
 *      table to stderr. If nothing is specified, the entire
 *      hash table is dumped.
 *
 */
int dodump(argv, argc)
register char *argv[];
register int argc;
{
        register int n;
        ndptr p;
 
        if (argc > 2) {
                for (n = 2; n < argc; n++)
                        if ((p = lookup(argv[n])) != nil)
                                fprintf(stderr, dumpfmt, p->name,
                                p->defn);
        }
        else {
                for (n = 0; n < HASHSIZE; n++)
                        for (p = hashtab[n]; p != nil; p = p->nxtptr)
                                fprintf(stderr, dumpfmt, p->name,
                                p->defn);
        }
}
 
/*
 * doifelse - select one of two alternatives - loop.
 *
 */
int doifelse(argv,argc)
register char *argv[];
register int argc;
{
        cycle {
                if (strcmp(argv[2], argv[3]) == 0)
                        pbstr(argv[4]);
                else if (argc == 6)
                        pbstr(argv[5]);
                else if (argc > 6) {
                        argv += 3;
                        argc -= 3;
                        continue;
                }
                break;
        }
}
 
/*
 * doinclude - include a given file.
 *
 */
doincl(ifile)
char *ifile;
{
        if (ilevel+1 == MAXINP)
                error("m4: too many include files.");
        if ((infile[ilevel+1] = fopen(ifile, "r")) != NULL) {
                ilevel++;
                return (1);
        }
        else
                return (0);
}
 
#ifdef EXTENDED
/*
 * dopaste - include a given file without any
 *           macro processing.
 */
dopaste(pfile)
char *pfile;
{
        FILE *pf;
        register int c;
 
        if ((pf = fopen(pfile, "r")) != NULL) {
                while((c = getc(pf)) != EOF)
                        putc(c, active);
                (void) fclose(pf);
                return(1);
        }
        else
                return(0);
}
#endif
 
/*
 * dochq - change quote characters
 *
 */
int dochq(argv, argc)
register char *argv[];
register int argc;
{
        if (argc > 2) {
                if (*argv[2])
                        lquote = *argv[2];
                if (argc > 3) {
                        if (*argv[3])
                                rquote = *argv[3];
                }
                else
                        rquote = lquote;
        }
        else {
                lquote = LQUOTE;
                rquote = RQUOTE;
        }
}
 
/*
 * dochc - change comment characters
 *
 */
int dochc(argv, argc)
register char *argv[];
register int argc;
{
        if (argc > 2) {
                if (*argv[2])
                        scommt = *argv[2];
                if (argc > 3) {
                        if (*argv[3])
                                ecommt = *argv[3];
                }
                else
                        ecommt = ECOMMT;
        }
        else {
                scommt = SCOMMT;
                ecommt = ECOMMT;
        }
}
 
/*
 * dodivert - divert the output to a temporary file
 *
 */
int dodiv(n)
register int n;
{
        if (n < 0 || n >= MAXOUT)
                n = 0;                  /* bitbucket */
        if (outfile[n] == NULL) {
                m4temp[UNIQUE] = n + '0';
                if ((outfile[n] = fopen(m4temp, "w")) == NULL)
                        error("m4: cannot divert.");
        }
        oindex = n;
        active = outfile[n];
}
 
/*
 * doundivert - undivert a specified output, or all
 *              other outputs, in numerical order.
 */
int doundiv(argv, argc)
register char *argv[];
register int argc;
{
        register int ind;
        register int n;
 
        if (argc > 2) {
                for (ind = 2; ind < argc; ind++) {
                        n = atoi(argv[ind]);
                        if (n > 0 && n < MAXOUT && outfile[n] != NULL)
                                getdiv(n);
 
                }
        }
        else
                for (n = 1; n < MAXOUT; n++)
                        if (outfile[n] != NULL)
                                getdiv(n);
}
 
/*
 * dosub - select substring
 *
 */
int dosub (argv, argc)
register char *argv[];
register int  argc;
{
        register char *ap, *fc, *k;
        register int nc;
 
        if (argc < 5)
                nc = MAXTOK;
        else
#ifdef EXPR
                nc = expr(argv[4]);
#else
		nc = atoi(argv[4]);
#endif
        ap = argv[2];                   /* target string */
#ifdef EXPR
        fc = ap + expr(argv[3]);        /* first char */
#else
        fc = ap + atoi(argv[3]);        /* first char */
#endif
        if (fc >= ap && fc < ap+strlen(ap))
                for (k = fc+min(nc,strlen(fc))-1; k >= fc; k--)
                        putback(*k);
}
 
/*
 * map:
 * map every character of s1 that is specified in from
 * into s3 and replace in s. (source s1 remains untouched)
 *
 * This is a standard implementation of map(s,from,to) function of ICON 
 * language. Within mapvec, we replace every character of "from" with 
 * the corresponding character in "to". If "to" is shorter than "from", 
 * than the corresponding entries are null, which means that those 
 * characters dissapear altogether. Furthermore, imagine 
 * map(dest, "sourcestring", "srtin", "rn..*") type call. In this case, 
 * `s' maps to `r', `r' maps to `n' and `n' maps to `*'. Thus, `s' 
 * ultimately maps to `*'. In order to achieve this effect in an efficient 
 * manner (i.e. without multiple passes over the destination string), we 
 * loop over mapvec, starting with the initial source character. if the 
 * character value (dch) in this location is different than the source 
 * character (sch), sch becomes dch, once again to index into mapvec, until 
 * the character value stabilizes (i.e. sch = dch, in other words 
 * mapvec[n] == n). Even if the entry in the mapvec is null for an ordinary 
 * character, it will stabilize, since mapvec[0] == 0 at all times. At the 
 * end, we restore mapvec* back to normal where mapvec[n] == n for 
 * 0 <= n <= 127. This strategy, along with the restoration of mapvec, is 
 * about 5 times faster than any algorithm that makes multiple passes over 
 * destination string.
 *
 */
     
int map(dest,src,from,to)
register char *dest;
register char *src;
register char *from;
register char *to;
{
        register char *tmp;
        register char sch, dch;
        static char mapvec[128] = {
                0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
                12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23,
                24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,
                36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,
                48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
                60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71,
                72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83,
                84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,
                96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107,
                108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,
                120, 121, 122, 123, 124, 125, 126, 127
        };
 
        if (*src) {
                tmp = from;
	/*
	 * create a mapping between "from" and "to"
	 */
                while (*from)
                        mapvec[*from++] = (*to) ? *to++ : (char) 0;
     
                while (*src) {
                        sch = *src++;
                        dch = mapvec[sch];
                        while (dch != sch) {
                                sch = dch;
                                dch = mapvec[sch];
                        }
                        if (*dest = dch)
                                dest++;
                }
	/*
	 * restore all the changed characters
	 */
                while (*tmp) {
                        mapvec[*tmp] = *tmp;
                        tmp++;
                }
        }
        *dest = (char) 0;
}
SHAR_EOF
if test 11602 -ne "`wc -c serv.c`"
then
echo shar: error transmitting serv.c '(should have been 11602 characters)'
fi
echo shar: extracting main.c.orig '(11102 characters)'
cat << \SHAR_EOF > main.c.orig
/*
 * main.c
 * Facility: m4 macro processor
 * by: oz
 */

#include "mdef.h"

/*
 * m4 - macro processor
 *
 * PD m4 is based on the macro tool distributed with the software 
 * tools (VOS) package, and described in the "SOFTWARE TOOLS" and 
 * "SOFTWARE TOOLS IN PASCAL" books. It has been expanded to include 
 * most of the command set of SysV m4, the standard UN*X macro processor.
 *
 * Since both PD m4 and UN*X m4 are based on SOFTWARE TOOLS macro,
 * there may be certain implementation similarities between
 * the two. The PD m4 was produced without ANY references to m4
 * sources.
 *
 * References:
 *
 *	Software Tools distribution: macro
 *
 *	Kernighan, Brian W. and P. J. Plauger, SOFTWARE
 *	TOOLS IN PASCAL, Addison-Wesley, Mass. 1981
 *
 *	Kernighan, Brian W. and P. J. Plauger, SOFTWARE
 *	TOOLS, Addison-Wesley, Mass. 1976
 *
 *	Kernighan, Brian W. and Dennis M. Ritchie,
 *	THE M4 MACRO PROCESSOR, Unix Programmer's Manual,
 *	Seventh Edition, Vol. 2, Bell Telephone Labs, 1979
 *
 *	System V man page for M4
 *
 * Modification History:
 *
 * Jan 28 1986 Oz	Break the whole thing into little
 *			pieces, for easier (?) maintenance.
 *
 * Dec 12 1985 Oz	Optimize the code, try to squeeze
 *			few microseconds out..
 *
 * Dec 05 1985 Oz	Add getopt interface, define (-D),
 *			undefine (-U) options.
 *
 * Oct 21 1985 Oz	Clean up various bugs, add comment handling.
 *
 * June 7 1985 Oz	Add some of SysV m4 stuff (m4wrap, pushdef,
 *			popdef, decr, shift etc.).
 *
 * June 5 1985 Oz	Initial cut.
 *
 * Implementation Notes:
 *
 * [1]	PD m4 uses a different (and simpler) stack mechanism than the one 
 *	described in Software Tools and Software Tools in Pascal books. 
 *	The triple stack nonsense is replaced with a single stack containing 
 *	the call frames and the arguments. Each frame is back-linked to a 
 * 	previous stack frame, which enables us to rewind the stack after 
 * 	each nested call is completed. Each argument is a character pointer 
 *	to the beginning of the argument string within the string space.
 *	The only exceptions to this are (*) arg 0 and arg 1, which are
 * 	the macro definition and macro name strings, stored dynamically
 *	for the hash table.
 *
 *	    .					   .
 *	|   .	|  <-- sp			|  .  |
 *	+-------+				+-----+
 *	| arg 3 ------------------------------->| str |
 *	+-------+				|  .  |
 *	| arg 2 --------------+ 		   .
 *	+-------+	      |
 *	    *		      |			|     |
 *	+-------+	      | 		+-----+
 *	| plev	|  <-- fp     +---------------->| str |
 *	+-------+				|  .  |
 *	| type	|				   .
 *	+-------+
 *	| prcf	-----------+		plev: paren level
 *	+-------+  	   |		type: call type
 *	|   .	| 	   |		prcf: prev. call frame
 *	    .	   	   |
 *	+-------+	   |
 *	|	<----------+
 *	+-------+
 *
 * [2]	We have three types of null values:
 *
 *		nil  - nodeblock pointer type 0
 *		null - null string ("")
 *		NULL - Stdio-defined NULL
 *
 */

#ifdef MYMKTMP
int mytmpnum=000000;		/* used in mktemp()	       */
#endif

ndptr hashtab[HASHSIZE];	/* hash table for macros etc.  */
char buf[BUFSIZE];		/* push-back buffer	       */
char *bp = buf; 		/* first available character   */
char *endpbb = buf+BUFSIZE;	/* end of push-back buffer     */
stae mstack[STACKMAX+1]; 	/* stack of m4 machine         */
char strspace[STRSPMAX+1];	/* string space for evaluation */
char *ep = strspace;		/* first free char in strspace */
char *endest= strspace+STRSPMAX;/* end of string space	       */
int sp; 			/* current m4  stack pointer   */
int fp; 			/* m4 call frame pointer       */
FILE *infile[MAXINP];		/* input file stack (0=stdin)  */
FILE *outfile[MAXOUT];		/* diversion array(0=bitbucket)*/
FILE *active;			/* active output file pointer  */
char *m4temp;			/* filename for diversions     */
int ilevel = 0; 		/* input file stack pointer    */
int oindex = 0; 		/* diversion index..	       */
char *null = "";                /* as it says.. just a null..  */
char *m4wraps = "";             /* m4wrap string default..     */
char lquote = LQUOTE;		/* left quote character  (`)   */
char rquote = RQUOTE;		/* right quote character (')   */
char scommt = SCOMMT;		/* start character for comment */
char ecommt = ECOMMT;		/* end character for comment   */
struct keyblk keywrds[] = {	/* m4 keywords to be installed */
	"include",      INCLTYPE,
	"sinclude",     SINCTYPE,
	"define",       DEFITYPE,
	"defn",         DEFNTYPE,
	"divert",       DIVRTYPE,
	"expr",         EXPRTYPE,
	"eval",         EXPRTYPE,
	"substr",       SUBSTYPE,
	"ifelse",       IFELTYPE,
	"ifdef",        IFDFTYPE,
	"len",          LENGTYPE,
	"incr",         INCRTYPE,
	"decr",         DECRTYPE,
	"dnl",          DNLNTYPE,
	"changequote",  CHNQTYPE,
	"changecom",    CHNCTYPE,
	"index",        INDXTYPE,
#ifdef EXTENDED
	"paste",        PASTTYPE,
	"spaste",       SPASTYPE,
#endif
	"popdef",       POPDTYPE,
	"pushdef",      PUSDTYPE,
	"dumpdef",      DUMPTYPE,
	"shift",        SHIFTYPE,
	"translit",     TRNLTYPE,
	"undefine",     UNDFTYPE,
	"undivert",     UNDVTYPE,
	"divnum",       DIVNTYPE,
	"maketemp",     MKTMTYPE,
	"errprint",     ERRPTYPE,
	"m4wrap",       M4WRTYPE,
	"m4exit",       EXITTYPE,
#if unix || vms
	"syscmd",       SYSCTYPE,
	"sysval",       SYSVTYPE,
#endif
#if unix
	"unix",         MACRTYPE,
#else
#if vms
	"vms",          MACRTYPE,
#endif
#endif
};

#define MAXKEYS	(sizeof(keywrds)/sizeof(struct keyblk))

extern ndptr lookup();
extern ndptr addent();
extern int onintr();

extern char *malloc();
extern char *mktemp();

extern int optind;
extern char *optarg;

main(argc,argv)
char *argv[];
{
	register int c;
	register int n;
	char *p;

	if (signal(SIGINT, SIG_IGN) != SIG_IGN)
		signal(SIGINT, onintr);
#ifdef NONZEROPAGES
	initm4();
#endif
	initkwds();

	while ((c = getopt(argc, argv, "tD:U:o:")) != EOF)
		switch(c) {

		case 'D':               /* define something..*/
			for (p = optarg; *p; p++)
				if (*p == '=')
					break;
			if (*p)
				*p++ = EOS;
			dodefine(optarg, p);
			break;
		case 'U':               /* undefine...       */
			remhash(optarg, TOP);
			break;
		case 'o':		/* specific output   */
		case '?':
		default:
			usage();
		}

	infile[0] = stdin;		/* default input (naturally) */
	active = stdout;		/* default active output     */
 	m4temp = mktemp(DIVNAM);	/* filename for diversions   */

	sp = -1;			/* stack pointer initialized */
	fp = 0; 			/* frame pointer initialized */

	macro();			/* get some work done here   */

	if (*m4wraps) { 		/* anything for rundown ??   */
		ilevel = 0;		/* in case m4wrap includes.. */
		putback(EOF);		/* eof is a must !!	     */
		pbstr(m4wraps); 	/* user-defined wrapup act   */
		macro();		/* last will and testament   */
	}
	else				/* default wrap-up: undivert */
		for (n = 1; n < MAXOUT; n++)
			if (outfile[n] != NULL)
				getdiv(n);

					/* remove bitbucket if used  */
	if (outfile[0] != NULL) {
		(void) fclose(outfile[0]);
		m4temp[UNIQUE] = '0';
#if vms
		(void) remove(m4temp);
#else
		(void) unlink(m4temp);
#endif
	}

	exit(0);
}

ndptr inspect();	/* forward ... */

/*
 * macro - the work horse..
 *
 */
macro() {
	char token[MAXTOK];
	register char *s;
	register int t, l;
	register ndptr p;
	register int  nlpar;

	cycle {
		if ((t = gpbc()) == '_' || isalpha(t)) {
			putback(t);
			if ((p = inspect(s = token)) == nil) {
				if (sp < 0)
					while (*s)
						putc(*s++, active);
				else
					while (*s)
						chrsave(*s++);
			}
			else {
		/*
		 * real thing.. First build a call frame:
		 *
		 */
				pushf(fp);	/* previous call frm */
				pushf(p->type); /* type of the call  */
				pushf(0);	/* parenthesis level */
				fp = sp;	/* new frame pointer */
		/*
		 * now push the string arguments:
		 *
		 */
				pushs(p->defn);	      /* defn string */
				pushs(p->name);	      /* macro name  */
				pushs(ep);	      /* start next..*/

				putback(l = gpbc());
				if (l != LPAREN)  {   /* add bracks  */
					putback(RPAREN);
					putback(LPAREN);
				}
			}
		}
		else if (t == EOF) {
			if (sp > -1)
				error("m4: unexpected end of input");
			if (--ilevel < 0)
				break;			/* all done thanks.. */
			(void) fclose(infile[ilevel+1]);
			continue;
		}
	/*
	 * non-alpha single-char token seen..
	 * [the order of else if .. stmts is
	 * important.]
	 *
	 */
		else if (t == lquote) { 		/* strip quotes */
			nlpar = 1;
			do {
				if ((l = gpbc()) == rquote)
					nlpar--;
				else if (l == lquote)
					nlpar++;
				else if (l == EOF)
					error("m4: missing right quote");
				if (nlpar > 0)
					chrsave(l);
			}
			while (nlpar != 0);
		}

		else if (sp < 0) {		/* not in a macro at all */
			if (t == scommt) {	/* comment handling here */
				putc(t, active);
				while ((t = gpbc()) != ecommt)
					putc(t, active);
			}
			putc(t, active);	/* output directly..	 */
		}

		else switch(t) {

		case LPAREN:
			if (PARLEV > 0)
				chrsave(t);
			while (isspace(l = gpbc()))
				;		/* skip blank, tab, nl.. */
			putback(l);
			PARLEV++;
			break;

		case RPAREN:
			if (--PARLEV > 0)
				chrsave(t);
			else {			/* end of argument list */
				chrsave(EOS);

				if (sp == STACKMAX)
					error("m4: internal stack overflow");

				if (CALTYP == MACRTYPE)
					expand(mstack+fp+1, sp-fp);
				else
					eval(mstack+fp+1, sp-fp, CALTYP);

				ep = PREVEP;	/* flush strspace */
				sp = PREVSP;	/* previous sp..  */
				fp = PREVFP;	/* rewind stack...*/
			}
			break;

		case COMMA:
			if (PARLEV == 1)	{
				chrsave(EOS);		/* new argument   */
				while (isspace(l = gpbc()))
					;
				putback(l);
				pushs(ep);
			}
			break;
		default:
			chrsave(t);			/* stack the char */
			break;
		}
	}
}


/*
 * build an input token..
 * consider only those starting with _ or A-Za-z. This is a
 * combo with lookup to speed things up.
 */
ndptr
inspect(tp) 
register char *tp;
{
	register int h = 0;
	register char c;
	register char *name = tp;
	register char *etp = tp+MAXTOK;
	register ndptr p;

	while (tp < etp && (isalnum(c = gpbc()) || c == '_'))
		h += (*tp++ = c);
	putback(c);
	if (tp == etp)
		error("m4: token too long");
	*tp = EOS;
	for (p = hashtab[h%HASHSIZE]; p != nil; p = p->nxtptr)
		if (strcmp(name, p->name) == 0)
			break;
	return(p);
}

#ifdef NONZEROPAGES
/*
 * initm4 - initialize various tables. Useful only if your system 
 * does not know anything about demand-zero pages.
 *
 */
initm4()
{
	register int i;

	for (i = 0; i < HASHSIZE; i++)
		hashtab[i] = nil;
	for (i = 0; i < MAXOUT; i++)
		outfile[i] = NULL;
}
#endif

/*
 * initkwds - initialise m4 keywords as fast as possible. 
 * This very similar to install, but without certain overheads,
 * such as calling lookup. Malloc is not used for storing the 
 * keyword strings, since we simply use the static  pointers
 * within keywrds block. We also assume that there is enough memory 
 * to at least install the keywords (i.e. malloc won't fail).
 *
 */
initkwds() {
	register int i;
	register int h;
	register ndptr p;

	for (i = 0; i < MAXKEYS; i++) {
		h = hash(keywrds[i].knam);
		p = (ndptr) malloc(sizeof(struct ndblock));
		p->nxtptr = hashtab[h];
		hashtab[h] = p;
		p->name = keywrds[i].knam;
		p->defn = null;
		p->type = keywrds[i].ktyp | STATIC;
	}
}
SHAR_EOF
if test 11102 -ne "`wc -c main.c.orig`"
then
echo shar: error transmitting main.c.orig '(should have been 11102 characters)'
fi
echo shar: extracting m4.1 '(9643 characters)'
cat << \SHAR_EOF > m4.1
.TH M4 local "30 Aug 1987"
.DA 08 Jan 1986
.SH NAME
pd m4 \- macro processor
.SH ORIGIN
MetaSystems
.SH SYNOPSIS
.BI m4 "[ options ]"
.SH DESCRIPTION
.I Pd M4
is a un*x M4 look-alike macro processor
intended as a front end for Ratfor, Pascal, and other languages that do not
have a built-in macro processing capability.
Pd M4 reads standard input, the processed text is written on the standard output.
.PP
The options and their effects are as follows:
.TP
\f3\-D\fP\f2name\^\fP[\f3=\fP\f2val\^\fP]
Defines
.I name
to
.I val
or to null in
.IR val 's
absence.
.TP
.BI \-U name
undefines
.IR name .
.PP
Macro calls
have the form:
.PP
.RS
\fBname\fI(arg1,arg2, .\|.\|., argn)\fR
.RE
.PP
The
.B (
must immediately follow the name of the macro.
If the name of a defined macro is not followed by a
.BR ( ,
it is taken to be a call of that macro with no arguments, i.e. name().
Potential macro names consist of alphabetic letters and digits.
.PP
Leading unquoted blanks, tabs and newlines are ignored while collecting 
arguments.
Left and right single quotes are used to quote strings.
The value of a quoted string is the string stripped of the quotes.
.PP
When a macro name is recognized,
its arguments are collected by searching for a matching
.BR ) .
If fewer arguments are supplied than are in the macro definition,
the trailing arguments are taken to be null.
Macro evaluation proceeds normally during the collection of the arguments,
and any commas or right parentheses
which happen to turn up within the value of a nested
call are as effective as those in the original input text. (This is typically
referred as
.I inside-out
macro expansion.)
After argument collection,
the value of the macro is pushed back onto the input stream
and rescanned.
.PP
.I Pd M4
makes available the following built-in macros.
They may be redefined, but once this is done the original meaning is lost.
Their values are null unless otherwise stated.
.de MC
.TP 14
.B \\$1
usage: \\fI\\$1\\$2\\fR
.br
..
.MC define "(name [, val])"
the second argument is installed as the value of the macro
whose name is the first argument. If there is no second argument,
the value is null.
Each occurrence of
.BI $ n
in the replacement text,
where
.I n
is a digit,
is replaced by the
.IR n -th
argument.
Argument 0 is the name of the macro;
missing arguments are replaced by the null string.
.MC defn "(name [, name ...])
returns the quoted definition of its argument(s). Useful in renaming
macros.
.MC undefine "(name [, name ...])"
removes the definition of the macro(s) named. If there is
more than one definition for the named macro, (due to previous use of
.IR pushdef ) 
all definitions are removed.
.MC pushdef "(name [, val])"
like
.IR define ,
but saves any previous definition by stacking the current definition.
.MC popdef "(name [, name ...])"
removes current definition of its argument(s),
exposing the previous one if any.
.MC ifdef "(name, if-def [, ifnot-def])"
if the first argument is defined, the value is the second argument, 
otherwise the third.
If there is no third argument, the value is null.
A word indicating the current operating system is predefined.
(e.g.
.I unix
or
.IR vms )
.MC shift "(arg, arg, arg, ...)"
returns all but its first argument.
The other arguments are quoted and pushed back with
commas in between.
The quoting nullifies the effect of the extra scan that
will subsequently be performed.
.MC changequote "(lqchar, rqchar)"
change quote symbols to the first and second arguments.
With no arguments, the quotes are reset back to the default
characters. (i.e., \*`\|\*').
.MC changecom "(lcchar, rcchar)"
change left and right comment markers from the default
.B #
and 
.BR newline .
With no arguments, the comment mechanism is reset back to 
the default characters.
With one argument, the left marker becomes the argument and
the right marker becomes newline.
With two arguments, both markers are affected.
.MC divert "(divnum)"
.I m4
maintains 10 output streams,
numbered 0-9.  initially stream 0 is the current stream. 
The
.I divert
macro changes the current output stream to its (digit-string)
argument.
Output diverted to a stream other than 0 through 9
disappears into bitbucket.
.MC undivert "([divnum [, divnum ...]])"
causes immediate output of text from diversions named as
argument(s), or all diversions if no argument.
Text may be undiverted into another diversion.
Undiverting discards the diverted text. At the end of input processing,
.I M4
forces an automatic
.IR undivert ,
unless
.I m4wrap
is defined.
.MC divnum "()"
returns the value of the current output stream.
.MC dnl "()"
reads and discards characters up to and including the next newline.
.MC ifelse "(arg, arg, if-same [, ifnot-same | arg, arg ...])"
has three or more arguments.
If the first argument is the same string as the second,
then the value is the third argument.
If not, and if there are more than four arguments, the process is 
repeated with arguments 4, 5, 6 and 7.
Otherwise, the value is either the fourth string, or, if it is not present,
null.
.MC incr "(num)"
returns the value of its argument incremented by 1.
The value of the argument is calculated
by interpreting an initial digit-string as a decimal number.
.MC decr "(num)"
returns the value of its argument decremented by 1.
.MC eval "(expression)"
evaluates its argument as a constant expression, using integer arithmetic.
The evaluation mechanism is very similar to that of
.I cpp
(#if expression). 
The expression can involve only integer constants and character constants,
possibly connected by the binary operators
.nf
.ft B

*	/	%	+	-	>>	<<	<	>	
<=	>=	==	!=	&	^	|	&&	||

.ft R
.fi
or the unary operators \fB\- ~ !\fR
or by the ternary operator \fB ? : \fR.
Parentheses may be used for grouping. Octal numbers may be specified as
in C.
.MC len "(string)"
returns the number of characters in its argument.
.MC index "(search-string, string)"
returns the position in its first argument where the second argument 
begins (zero origin),
or \-1 if the second argument does not occur.
.MC substr "(string, index [, length])"
returns a substring of its first argument.
The second argument is a zero origin
number selecting the first character (internally treated as an expression);
the third argument indicates the length of the substring.
A missing third argument is taken to be large enough to extend to
the end of the first string. 
.MC translit "(source, from [, to])"
transliterates the characters in its first argument
from the set given by the second argument to the set given by the third.
If the third argument is shorter than the second, all extra characters
in the second argument are deleted from the first argument. If the third
argument is missing altogether, all characters in the second argument are
deleted from the first argument.
.MC include "(filename)"
returns the contents of the file named in the argument.
.MC sinclude "(filename)"
is identical to
.IR include ,
except that it
says nothing if the file is inaccessible.
.MC paste "(filename)"
returns the contents of the file named in the argument without any
processing, unlike 
.IR include.
.MC spaste "(filename)"
is identical to
.IR paste ,
except that it says nothing if the file is inaccessible.
.MC syscmd "(command)"
executes the
.SM UNIX
command given in the first argument.
No value is returned.
.MC sysval "()"
is the return code from the last call to
.IR syscmd .
.MC maketemp "(string)"
fills in a string of
.SM XXXXXX
in its argument with the current process
.SM ID\*S.
.MC m4exit "([exitcode])"
causes immediate exit from
.IR m4 .
Argument 1, if given, is the exit code;
the default is 0.
.MC m4wrap "(m4-macro-or-built-in)"
argument 1 will be pushed back at final
.BR EOF ;
example: m4wrap(`dumptable()').
.MC errprint "(str [, str, str, ...])"
prints its argument(s) on stderr. If there is more than one argument,
each argument is separated by a space during the output.
.MC dumpdef "([name, name, ...])"
prints current names and definitions,
for the named items, or for all if no arguments are given.
.dt
.SH AUTHOR
Ozan S. Yigit (oz)
.SH BUGS
Pd M4 is distributed at the source level, and does not require an expensive
license agreement.
.PP
A sufficiently complex M4 macro set is about as readable
as
.BR APL .
.PP
All complex uses of M4 require the ability to program in deep recursion.
Previous lisp experience is recommended.
.PP
Pd M4 is slower than V7 M4.
.SH EXAMPLES
.PP
The following macro program illustrates the type of things that
can be done with M4. 
.PP
.RS
.nf
\fBchangequote\fR(<,>) \fBdefine\fR(HASHVAL,99) \fBdnl\fR
\fBdefine\fR(hash,<\fBexpr\fR(str(\fBsubstr\fR($1,1),0)%HASHVAL)>) \fBdnl\fR
\fBdefine\fR(str,
	<\fBifelse\fR($1,",$2,
		<str(\fBsubstr\fR(<$1>,1),<\fBexpr\fR($2+'\fBsubstr\fR($1,0,1)')>)>)
	>) \fBdnl\fR
\fBdefine\fR(KEYWORD,<$1,hash($1),>) \fBdnl\fR
\fBdefine\fR(TSTART,
<struct prehash {
	char *keyword;
	int   hashval;
} keytab[] = {>) \fBdnl\fR
\fBdefine\fR(TEND,<	"",0
};>) \fBdnl\fR
.fi
.RE
.PP
Thus a keyword table containing the keyword string and its pre-calculated
hash value may be generated thus:
.PP
.RS
.nf
TSTART
	KEYWORD("foo")
	KEYWORD("bar")
	KEYWORD("baz")
TEND
.fi
.RE
.PP
which will expand into:
.RS
.nf
struct prehash {
	char *keyword;
	int   hashval;
} keytab[] = {
	"foo",27,
	"bar",12,
	"baz",20,
	"",0
};
.fi
.RE
.PP
Presumably, such a table would speed up the installation of the
keywords into a dynamic hash table. (Note that the above macro
cannot be used with 
.IR M4 , 
since 
.B eval
does not handle character constants.)

.SH SEE ALSO
cc(1),
m4(1),
cpp(1).
.I "The M4 Macro Processor\^"
by B. W. Kernighan and D. M. Ritchie.
SHAR_EOF
if test 9643 -ne "`wc -c m4.1`"
then
echo shar: error transmitting m4.1 '(should have been 9643 characters)'
fi
#	End of shell archive
exit 0