add directory study

This commit is contained in:
gohigh
2024-02-19 00:25:23 -05:00
parent b1306b38b1
commit f3774e2f8c
4001 changed files with 2285787 additions and 0 deletions

View File

@@ -0,0 +1,2 @@
define(ack, `ifelse($1,0,incr($2),$2,0,`ack(DECR($1),1)',
`ack(DECR($1), ack($1,DECR($2)))')')

View File

@@ -0,0 +1,7 @@
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))')')

View File

@@ -0,0 +1,17 @@
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

View File

@@ -0,0 +1,462 @@
#
# test file for mp (not comprehensive)
#
# v7 m4 does not have `decr'.
#
#
# include string macros
#
#
# create some fortrash strings for an even uglier language
#
integer TEXT(5)
data TEXT(1)/LETt/
data TEXT(2)/LETe/
data TEXT(3)/LETx/
data TEXT(4)/LETt/
data TEXT(5)/EOS/
integer DATA(5)
data DATA(1)/LETd/
data DATA(2)/LETa/
data DATA(3)/LETt/
data DATA(4)/LETa/
data DATA(5)/EOS/
integer BEGIN(6)
data BEGIN(1)/LETb/
data BEGIN(2)/LETe/
data BEGIN(3)/LETg/
data BEGIN(4)/LETi/
data BEGIN(5)/LETn/
data BEGIN(6)/EOS/
integer END(4)
data END(1)/LETe/
data END(2)/LETn/
data END(3)/LETd/
data END(4)/EOS/
integer IF(3)
data IF(1)/LETi/
data IF(2)/LETf/
data IF(3)/EOS/
integer THEN(5)
data THEN(1)/LETt/
data THEN(2)/LETh/
data THEN(3)/LETe/
data THEN(4)/LETn/
data THEN(5)/EOS/
integer ELSE(5)
data ELSE(1)/LETe/
data ELSE(2)/LETl/
data ELSE(3)/LETs/
data ELSE(4)/LETe/
data ELSE(5)/EOS/
integer CASE(5)
data CASE(1)/LETc/
data CASE(2)/LETa/
data CASE(3)/LETs/
data CASE(4)/LETe/
data CASE(5)/EOS/
integer REPEAT(7)
data REPEAT(1)/LETr/
data REPEAT(2)/LETe/
data REPEAT(3)/LETp/
data REPEAT(4)/LETe/
data REPEAT(5)/LETa/
data REPEAT(6)/LETt/
data REPEAT(7)/EOS/
integer WHILE(6)
data WHILE(1)/LETw/
data WHILE(2)/LETh/
data WHILE(3)/LETi/
data WHILE(4)/LETl/
data WHILE(5)/LETe/
data WHILE(6)/EOS/
integer DEFAULT(8)
data DEFAULT(1)/LETd/
data DEFAULT(2)/LETe/
data DEFAULT(3)/LETf/
data DEFAULT(4)/LETa/
data DEFAULT(5)/LETu/
data DEFAULT(6)/LETl/
data DEFAULT(7)/LETt/
data DEFAULT(8)/EOS/
integer UNTIL(6)
data UNTIL(1)/LETu/
data UNTIL(2)/LETn/
data UNTIL(3)/LETt/
data UNTIL(4)/LETi/
data UNTIL(5)/LETl/
data UNTIL(6)/EOS/
integer FUNCTION(9)
data FUNCTION(1)/LETf/
data FUNCTION(2)/LETu/
data FUNCTION(3)/LETn/
data FUNCTION(4)/LETc/
data FUNCTION(5)/LETt/
data FUNCTION(6)/LETi/
data FUNCTION(7)/LETo/
data FUNCTION(8)/LETn/
data FUNCTION(9)/EOS/
integer PROCEDURE(10)
data PROCEDURE(1)/LETp/
data PROCEDURE(2)/LETr/
data PROCEDURE(3)/LETo/
data PROCEDURE(4)/LETc/
data PROCEDURE(5)/LETe/
data PROCEDURE(6)/LETd/
data PROCEDURE(7)/LETu/
data PROCEDURE(8)/LETr/
data PROCEDURE(9)/LETe/
data PROCEDURE(10)/EOS/
integer EXTERNAL(9)
data EXTERNAL(1)/LETe/
data EXTERNAL(2)/LETx/
data EXTERNAL(3)/LETt/
data EXTERNAL(4)/LETe/
data EXTERNAL(5)/LETr/
data EXTERNAL(6)/LETn/
data EXTERNAL(7)/LETa/
data EXTERNAL(8)/LETl/
data EXTERNAL(9)/EOS/
integer FORWARD(8)
data FORWARD(1)/LETf/
data FORWARD(2)/LETo/
data FORWARD(3)/LETr/
data FORWARD(4)/LETw/
data FORWARD(5)/LETa/
data FORWARD(6)/LETr/
data FORWARD(7)/LETd/
data FORWARD(8)/EOS/
integer TYPE(5)
data TYPE(1)/LETt/
data TYPE(2)/LETy/
data TYPE(3)/LETp/
data TYPE(4)/LETe/
data TYPE(5)/EOS/
integer VAR(4)
data VAR(1)/LETv/
data VAR(2)/LETa/
data VAR(3)/LETr/
data VAR(4)/EOS/
integer CONST(6)
data CONST(1)/LETc/
data CONST(2)/LETo/
data CONST(3)/LETn/
data CONST(4)/LETs/
data CONST(5)/LETt/
data CONST(6)/EOS/
integer PROGRAM(8)
data PROGRAM(1)/LETp/
data PROGRAM(2)/LETr/
data PROGRAM(3)/LETo/
data PROGRAM(4)/LETg/
data PROGRAM(5)/LETr/
data PROGRAM(6)/LETa/
data PROGRAM(7)/LETm/
data PROGRAM(8)/EOS/
integer INPUT(6)
data INPUT(1)/LETi/
data INPUT(2)/LETn/
data INPUT(3)/LETp/
data INPUT(4)/LETu/
data INPUT(5)/LETt/
data INPUT(6)/EOS/
integer OUTPUT(7)
data OUTPUT(1)/LETo/
data OUTPUT(2)/LETu/
data OUTPUT(3)/LETt/
data OUTPUT(4)/LETp/
data OUTPUT(5)/LETu/
data OUTPUT(6)/LETt/
data OUTPUT(7)/EOS/
#
defined
#
# v7 m4 does this wrong. The right output is
# this is A vEry lon sEntEnCE
# see m4 documentation for translit.
#
this is A vEry lon sEntEnCE
#
# include towers-of-hanoi
#
#
# some reasonable set of disks
#
move disk from A to C
move disk from A to B
move disk from C to B
move disk from A to C
move disk from B to A
move disk from B to C
move disk from A to C
move disk from A to B
move disk from C to B
move disk from C to A
move disk from B to A
move disk from C to B
move disk from A to C
move disk from A to B
move disk from C to B
move disk from A to C
move disk from B to A
move disk from B to C
move disk from A to C
move disk from B to A
move disk from C to B
move disk from C to A
move disk from B to A
move disk from B to C
move disk from A to C
move disk from A to B
move disk from C to B
move disk from A to C
move disk from B to A
move disk from B to C
move disk from A to C
move disk from A to B
move disk from C to B
move disk from C to A
move disk from B to A
move disk from C to B
move disk from A to C
move disk from A to B
move disk from C to B
move disk from C to A
move disk from B to A
move disk from B to C
move disk from A to C
move disk from B to A
move disk from C to B
move disk from C to A
move disk from B to A
move disk from C to B
move disk from A to C
move disk from A to B
move disk from C to B
move disk from A to C
move disk from B to A
move disk from B to C
move disk from A to C
move disk from A to B
move disk from C to B
move disk from C to A
move disk from B to A
move disk from C to B
move disk from A to C
move disk from A to B
move disk from C to B
#
# include ackermann's function
#
#
# something like (3,3) will blow away un*x m4.
#
9
#
# include a square_root function for fixed nums
#
#
# some square roots.
#
3
10
negative-square-root
146
#
# 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..
#
diversion #1
diversion #2
diversion #3
diversion #4

View File

@@ -0,0 +1,14 @@
# -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.
# -DDUFFCP #if you do not have fast memcpy in your library.
#
CFLAGS = -DEXTENDED
OBJS = main.s eval.s serv.s look.s misc.s expr.s
INCL = mdef.h extr.h patchlevel.h
m4: $(OBJS) $(INCL)
cc -o m4 $(OBJS)
clean:
@rm -f *.bak *.s m4

View File

@@ -0,0 +1,12 @@
# -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.
# -DDUFFCP #if you do not have fast memcpy in your library.
#
CFLAGS = -DEXTENDED -O -DATARI_ST
OBJS = main.o eval.o serv.o look.o misc.o expr.o
INCL = mdef.h extr.h patchlevel.h
m4: $(OBJS) $(INCL)
@cc -o m4 $(OBJS)
@chmem =8192 m4

View File

@@ -0,0 +1,32 @@
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 (original) 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 two years
ago. [the name yetti now identifies a different machine]
If you have any important fixes and/or speed improvements, I am much
interested. 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.
Author:
Usenet: uunet!utai!yunexus!oz || oz@nexus.yorku.ca
Bitnet: oz@yulibra.BITNET
Phonet: [416] 736-5257 x 3976
enjoy. oz
Testing:
This directory contains a test file called test.m4. To use it, type
m4 <Test.m4 >out
The output file, out, should be identical to M4.out

View File

@@ -0,0 +1,7 @@
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))')')

View File

@@ -0,0 +1,8 @@
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))')')

View File

@@ -0,0 +1,206 @@
#
# 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..
#

View File

@@ -0,0 +1,335 @@
/*
* 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
*
*/
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;
}
}

View File

@@ -0,0 +1,559 @@
/*
* 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.
*/
experr(msg)
char *msg;
{
printf("mp: %s\n",msg);
longjmp(expjump, -1); /* Force eval() to return FALSE */
}

View File

@@ -0,0 +1,21 @@
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 */

View File

@@ -0,0 +1,113 @@
/*
* look.c
* Facility: m4 macro processor
* by: oz
*/
#include "mdef.h"
#include "extr.h"
extern char *strsave();
extern char *malloc();
/*
* 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
*
*/
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
*
*/
freent(p)
ndptr p;
{
if (!(p->type & STATIC)) {
free(p->name);
if (p->defn != null)
free(p->defn);
}
free(p);
}

View File

@@ -0,0 +1,452 @@
/*
* main.c
* Facility: m4 macro processor
* by: oz
*/
#include "mdef.h"
/*
* m4 - macro processor
*
* PD m4 is based on the macro tool distributed with the software
* tools (VOS) package, and described in the "SOFTWARE TOOLS" and
* "SOFTWARE TOOLS IN PASCAL" books. It has been expanded to include
* most of the command set of SysV m4, the standard UN*X macro processor.
*
* Since both PD m4 and UN*X m4 are based on SOFTWARE TOOLS macro,
* there may be certain implementation similarities between
* the two. The PD m4 was produced without ANY references to m4
* sources.
*
* References:
*
* Software Tools distribution: macro
*
* Kernighan, Brian W. and P. J. Plauger, SOFTWARE
* TOOLS IN PASCAL, Addison-Wesley, Mass. 1981
*
* Kernighan, Brian W. and P. J. Plauger, SOFTWARE
* TOOLS, Addison-Wesley, Mass. 1976
*
* Kernighan, Brian W. and Dennis M. Ritchie,
* THE M4 MACRO PROCESSOR, Unix Programmer's Manual,
* Seventh Edition, Vol. 2, Bell Telephone Labs, 1979
*
* System V man page for M4
*
* Modification History:
*
* Jan 28 1986 Oz Break the whole thing into little
* pieces, for easier (?) maintenance.
*
* Dec 12 1985 Oz Optimize the code, try to squeeze
* few microseconds out..
*
* Dec 05 1985 Oz Add getopt interface, define (-D),
* undefine (-U) options.
*
* Oct 21 1985 Oz Clean up various bugs, add comment handling.
*
* June 7 1985 Oz Add some of SysV m4 stuff (m4wrap, pushdef,
* popdef, decr, shift etc.).
*
* June 5 1985 Oz Initial cut.
*
* Implementation Notes:
*
* [1] PD m4 uses a different (and simpler) stack mechanism than the one
* described in Software Tools and Software Tools in Pascal books.
* The triple stack nonsense is replaced with a single stack containing
* the call frames and the arguments. Each frame is back-linked to a
* previous stack frame, which enables us to rewind the stack after
* each nested call is completed. Each argument is a character pointer
* to the beginning of the argument string within the string space.
* The only exceptions to this are (*) arg 0 and arg 1, which are
* the macro definition and macro name strings, stored dynamically
* for the hash table.
*
* . .
* | . | <-- sp | . |
* +-------+ +-----+
* | arg 3 ------------------------------->| str |
* +-------+ | . |
* | arg 2 --------------+ .
* +-------+ |
* * | | |
* +-------+ | +-----+
* | plev | <-- fp +---------------->| str |
* +-------+ | . |
* | type | .
* +-------+
* | prcf -----------+ plev: paren level
* +-------+ | type: call type
* | . | | prcf: prev. call frame
* . |
* +-------+ |
* | <----------+
* +-------+
*
* [2] We have three types of null values:
*
* nil - nodeblock pointer type 0
* null - null string ("")
* NULL - Stdio-defined NULL
*
*/
ndptr hashtab[HASHSIZE]; /* hash table for macros etc. */
char buf[BUFSIZE]; /* push-back buffer */
char *bp = buf; /* first available character */
char *endpbb = buf+BUFSIZE; /* end of push-back buffer */
stae mstack[STACKMAX+1]; /* stack of m4 machine */
char strspace[STRSPMAX+1]; /* string space for evaluation */
char *ep = strspace; /* first free char in strspace */
char *endest= strspace+STRSPMAX;/* end of string space */
int sp; /* current m4 stack pointer */
int fp; /* m4 call frame pointer */
FILE *infile[MAXINP]; /* input file stack (0=stdin) */
FILE *outfile[MAXOUT]; /* diversion array(0=bitbucket)*/
FILE *active; /* active output file pointer */
char *m4temp; /* filename for diversions */
int ilevel = 0; /* input file stack pointer */
int oindex = 0; /* diversion index.. */
char *null = ""; /* as it says.. just a null.. */
char *m4wraps = ""; /* m4wrap string default.. */
char lquote = LQUOTE; /* left quote character (`) */
char rquote = RQUOTE; /* right quote character (') */
char scommt = SCOMMT; /* start character for comment */
char ecommt = ECOMMT; /* end character for comment */
struct keyblk keywrds[] = { /* m4 keywords to be installed */
"include", INCLTYPE,
"sinclude", SINCTYPE,
"define", DEFITYPE,
"defn", DEFNTYPE,
"divert", DIVRTYPE,
"expr", EXPRTYPE,
"eval", EXPRTYPE,
"substr", SUBSTYPE,
"ifelse", IFELTYPE,
"ifdef", IFDFTYPE,
"len", LENGTYPE,
"incr", INCRTYPE,
"decr", DECRTYPE,
"dnl", DNLNTYPE,
"changequote", CHNQTYPE,
"changecom", CHNCTYPE,
"index", INDXTYPE,
#ifdef EXTENDED
"paste", PASTTYPE,
"spaste", SPASTYPE,
#endif
"popdef", POPDTYPE,
"pushdef", PUSDTYPE,
"dumpdef", DUMPTYPE,
"shift", SHIFTYPE,
"translit", TRNLTYPE,
"undefine", UNDFTYPE,
"undivert", UNDVTYPE,
"divnum", DIVNTYPE,
"maketemp", MKTMTYPE,
"errprint", ERRPTYPE,
"m4wrap", M4WRTYPE,
"m4exit", EXITTYPE,
#if unix || vms
"syscmd", SYSCTYPE,
"sysval", SYSVTYPE,
#endif
#if unix
"unix", MACRTYPE,
#else
#if vms
"vms", MACRTYPE,
#endif
#endif
};
#define MAXKEYS (sizeof(keywrds)/sizeof(struct keyblk))
extern ndptr lookup();
extern ndptr addent();
extern int onintr();
extern char *malloc();
extern char *mktemp();
extern int optind;
extern char *optarg;
main(argc,argv)
char *argv[];
{
register int c;
register int n;
char *p;
if (signal(SIGINT, SIG_IGN) != SIG_IGN)
signal(SIGINT, onintr);
#ifdef NONZEROPAGES
initm4();
#endif
initkwds();
while ((c = getopt(argc, argv, "tD:U:o:")) != EOF)
switch(c) {
case 'D': /* define something..*/
for (p = optarg; *p; p++)
if (*p == '=')
break;
if (*p)
*p++ = EOS;
dodefine(optarg, p);
break;
case 'U': /* undefine... */
remhash(optarg, TOP);
break;
case 'o': /* specific output */
case '?':
default:
usage();
}
infile[0] = stdin; /* default input (naturally) */
active = stdout; /* default active output */
m4temp = mktemp(DIVNAM); /* filename for diversions */
sp = -1; /* stack pointer initialized */
fp = 0; /* frame pointer initialized */
macro(); /* get some work done here */
if (*m4wraps) { /* anything for rundown ?? */
ilevel = 0; /* in case m4wrap includes.. */
putback(EOF); /* eof is a must !! */
pbstr(m4wraps); /* user-defined wrapup act */
macro(); /* last will and testament */
}
else /* default wrap-up: undivert */
for (n = 1; n < MAXOUT; n++)
if (outfile[n] != NULL)
getdiv(n);
/* remove bitbucket if used */
if (outfile[0] != NULL) {
(void) fclose(outfile[0]);
m4temp[UNIQUE] = '0';
#if vms
(void) remove(m4temp);
#else
(void) unlink(m4temp);
#endif
}
exit(0);
}
ndptr inspect(); /* forward ... */
/*
* macro - the work horse..
*
*/
macro() {
char token[MAXTOK];
register char *s;
register int t, l;
register ndptr p;
register int nlpar;
cycle {
if ((t = gpbc()) == '_' || isalpha(t)) {
putback(t);
if ((p = inspect(s = token)) == nil) {
if (sp < 0)
while (*s)
putc(*s++, active);
else
while (*s)
chrsave(*s++);
}
else {
/*
* real thing.. First build a call frame:
*
*/
pushf(fp); /* previous call frm */
pushf(p->type); /* type of the call */
pushf(0); /* parenthesis level */
fp = sp; /* new frame pointer */
/*
* now push the string arguments:
*
*/
pushs(p->defn); /* defn string */
pushs(p->name); /* macro name */
pushs(ep); /* start next..*/
putback(l = gpbc());
if (l != LPAREN) { /* add bracks */
putback(RPAREN);
putback(LPAREN);
}
}
}
else if (t == EOF) {
if (sp > -1)
error("m4: unexpected end of input");
if (--ilevel < 0)
break; /* all done thanks.. */
(void) fclose(infile[ilevel+1]);
continue;
}
/*
* non-alpha single-char token seen..
* [the order of else if .. stmts is
* important.]
*
*/
else if (t == lquote) { /* strip quotes */
nlpar = 1;
do {
if ((l = gpbc()) == rquote)
nlpar--;
else if (l == lquote)
nlpar++;
else if (l == EOF)
error("m4: missing right quote");
if (nlpar > 0) {
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).
*
*/
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;
}
}

View File

@@ -0,0 +1,194 @@
/*
* mdef.h
* Facility: m4 macro processor
* by: oz
*/
#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>
#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
#define DIVNAM "\M4*XXXXXX" /* msdos diversion files */
#define UNIQUE 3 /* unique char location */
#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)
#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)

View File

@@ -0,0 +1,291 @@
/*
* misc.c
* Facility: m4 macro processor
* by: oz
*/
#include "mdef.h"
#include "extr.h"
extern char *malloc();
/*
* indx - find the index of second str in the
* first str.
*/
indx(s1, s2)
char *s1;
char *s2;
{
register char *t;
register char *p;
register char *m;
for (p = s1; *p; p++) {
for (t = p, m = s2; *m && *m == *t; m++, t++)
;
if (!*m)
return(p - s1);
}
return (-1);
}
/*
* putback - push character back onto input
*
*/
putback (c)
char c;
{
if (bp < endpbb)
*bp++ = c;
else
error("m4: too many characters pushed back");
}
/*
* pbstr - push string back onto input
* putback is replicated to improve
* performance.
*
*/
pbstr(s)
register char *s;
{
register char *es;
register char *zp;
es = s;
zp = bp;
while (*es)
es++;
es--;
while (es >= s)
if (zp < endpbb)
*zp++ = *es--;
if ((bp = zp) == endpbb)
error("m4: too many characters pushed back");
}
/*
* pbnum - convert number to string, push back on input.
*
*/
pbnum (n)
int n;
{
register int num;
num = (n < 0) ? -n : n;
do {
putback(num % 10 + '0');
}
while ((num /= 10) > 0);
if (n < 0) putback('-');
}
/*
* chrsave - put single char on string space
*
*/
chrsave (c)
char c;
{
/*** if (sp < 0)
putc(c, active);
else ***/ if (ep < endest)
*ep++ = c;
else
error("m4: string space overflow");
}
/*
* getdiv - read in a diversion file, and
* trash it.
*/
getdiv(ind) {
register int c;
register FILE *dfil;
if (active == outfile[ind])
error("m4: undivert: diversion still active.");
(void) fclose(outfile[ind]);
outfile[ind] = NULL;
m4temp[UNIQUE] = ind + '0';
if ((dfil = fopen(m4temp, "r")) == NULL)
error("m4: cannot undivert.");
else
while((c = getc(dfil)) != EOF)
putc(c, active);
(void) fclose(dfil);
#if vms
if (remove(m4temp))
#else
if (unlink(m4temp) == -1)
#endif
error("m4: cannot unlink.");
}
/*
* Very fatal error. Close all files
* and die hard.
*/
error(s)
char *s;
{
killdiv();
fprintf(stderr,"%s\n",s);
exit(1);
}
/*
* Interrupt handling
*/
static char *msg = "\ninterrupted.";
onintr() {
error(msg);
}
/*
* killdiv - get rid of the diversion files
*
*/
killdiv() {
register int n;
for (n = 0; n < MAXOUT; n++)
if (outfile[n] != NULL) {
(void) fclose (outfile[n]);
m4temp[UNIQUE] = n + '0';
#if vms
(void) remove (m4temp);
#else
(void) unlink (m4temp);
#endif
}
}
/*
* save a string somewhere..
*
*/
char *strsave(s)
char *s;
{
register int n;
char *p;
if ((p = malloc (n = strlen(s)+1)) != NULL)
(void) memcpy(p, s, n);
return (p);
}
usage() {
fprintf(stderr, "Usage: m4 [-Dname[=val]] [-Uname]\n");
exit(1);
}
#ifdef GETOPT
/*
* H. Spencer getopt - get option letter from argv
*
*
#include <stdio.h>
*
*/
char *optarg; /* Global argument pointer. */
int optind = 0; /* Global argv index. */
static char *scan = NULL; /* Private scan pointer. */
extern char *index();
int
getopt(argc, argv, optstring)
int argc;
char *argv[];
char *optstring;
{
register char c;
register char *place;
optarg = NULL;
if (scan == NULL || *scan == '\0') {
if (optind == 0)
optind++;
if (optind >= argc || argv[optind][0] != '-' || argv[optind][1] == '\0')
return(EOF);
if (strcmp(argv[optind], "--")==0) {
optind++;
return(EOF);
}
scan = argv[optind]+1;
optind++;
}
c = *scan++;
place = index(optstring, c);
if (place == NULL || c == ':') {
fprintf(stderr, "%s: unknown option -%c\n", argv[0], c);
return('?');
}
place++;
if (*place == ':') {
if (*scan != '\0') {
optarg = scan;
scan = NULL;
} else {
optarg = argv[optind];
optind++;
}
}
return(c);
}
#endif
#ifdef DUFFCP
/*
* This code uses Duff's Device (tm Tom Duff)
* to unroll the copying loop:
* while (count-- > 0)
* *to++ = *from++;
*/
#define COPYBYTE *to++ = *from++
memcpy(to, from, count)
register char *from, *to;
register int count;
{
if (count > 0) {
register int loops = (count+8-1) >> 3; /* div 8 round up */
switch (count&(8-1)) { /* mod 8 */
case 0: do {
COPYBYTE;
case 7: COPYBYTE;
case 6: COPYBYTE;
case 5: COPYBYTE;
case 4: COPYBYTE;
case 3: COPYBYTE;
case 2: COPYBYTE;
case 1: COPYBYTE;
} while (--loops > 0);
}
}
}
#endif

View File

@@ -0,0 +1 @@
#define PATCHLEVEL 1

View File

@@ -0,0 +1,427 @@
/*
* 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
*
*/
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
*
*/
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.
*/
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.
*/
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.
*
*/
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.
*
*/
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
*
*/
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
*
*/
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
*
*/
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.
*/
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
*
*/
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.
*
*/
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;
}