These files contain all the code from "The Unix Programming Environment", by Brian Kernighan and Rob Pike (Prentice Hall, 1984, ISBN 0-13-937681-X). A separate hoc6 distribution contains any fixes that we have applied to that; the version in this file is from the book.
Copyright © Lucent Technologies, 1997. All Rights Reserved
Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both the copyright notice and this permission notice and warranty disclaimer appear in supporting documentation, and that the name of Lucent Technologies or any of its entities not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission.
LUCENT TECHNOLOGIES DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL LUCENT OR ANY OF ITS ENTITIES BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
3.1
hoc1
3.1.1
makefile
hoc1: hoc.o
cc hoc.o -o hoc1
3.1.2
hoc.y
%{
#define YYSTYPE double /* data type of yacc stack */
%}
%token NUMBER
%left '+' /* left associative, same precedence */
%left '*' '/' /* left assoc., higher precedence */
%%
list : /* nothing */
| list '\n'
| list expr '\n' { printf("\t%.8g\n", $2); }
;
expr: NUMBER { $$ = $1; }
| expr '+' expr { $$ = $1 + $3; }
| expr '-' expr { $$ = $1 - $3; }
| expr '*' expr { $$ = $1 * $3; }
| expr '/' expr { $$ = $1 / $3; }
| '(' expr ')' { $$ = $2; }
;
%%
/* end of grammar */
#include
#include
char *progname; /* for error messages */
int lineno = 1;
main(argc, argv) /* hoc1 */
char *argv[];
{
progname = argv[0];
yyparse();
}
yylex() /* hoc1 */
{
int c;
while ((c=getchar()) == ' ' || c == '\t')
;
if (c == EOF)
return 0;
if (c == '.' || isdigit(c)) { /* number */
ungetc(c, stdin);
scanf("%lf", &yylval);
return NUMBER;
if (c == '\n')
lineno++;
return c;
}
yyerror(s) /* called for yacc syntax error */
char *s;
{
warning(s, (char*)0);
}
warning(s, t) /* print warning message */
char *s, *t;
{
fprintf(stderr, "%s: %s", progname, s);
if (t)
fprintf(stderr, " %s", t);
fprintf(stderr, " near line %d\n", lineno);
}
3.1.3
hoc1.y
, версия 1.5
%{
#define YYSTYPE double /* data type of yacc stack */
%}
%token NUMBER
%left '-' '+'
%left '*' '/'
%left UNARYMINUS
%%
list: /* nothing */
| list '\n'
| list expr '\n' { printf("\t%.8g\n", $2); }
;
expr: NUMBER { $$ = $1; }
| expr '+' expr { $$ = $1 + $3; }
| expr '-' expr { $$ = $1 - $3; }
| expr '*' expr { $$ = $1 * $3; }
| expr '/' expr { $$ = $1 / $3; }
| '-' expr %prec UNARYMINUS { $$ = -$2; } /* new */
| '(' expr ')' { $$ = $2; }
;
%%
/* end of grammar */
#include
#include
char *progname; /* for error messages */
int lineno = 1;
main(argc, argv) /* hoc1 */
char *argv[];
{
progname = argv[0];
yyparse();
}
yylex() /* hoc1 */
{
int c;
while ((c=getchar()) == ' ' || с == '\t')
;
if (c == EOF)
return 0;
if (c == '.' || isdigit(c)) { /* number */
ungetc(c, stdin);
scanf("%lf", &yylval);
return NUMBER;
}
if (c == '\n')
lineno++;
return c;
}
yyerror(s)
char *s;
{
warning(s, (char *)0);
}
warning(s, t)
char *s, *t;
{
fprintf(stderr, "%s: %s", progname, s);
if (t && *t)
fprintf(stderr, "%s", t);
fprintf(stderr, " near line %d\n", lineno);
}
3.2
hoc2
3.2.1
hoc.y
%{
double mem[26]; /* memory for variables 'a'..'z' */
%}
%union { /* stack type */
double val; /* actual value */
int index; /* index into mem[] */
}
%token
%token
%type
%right '='
%left '+' '-'
%left '*' '/'
%left UNARYMINUS
%%
list: /* nothing */
| list '\n'
| list expr '\n' { printf("\t%.8g\n\ $2); }
| list error '\n' { yyerrok; }
;
expr: NUMBER
| VAR { $$ = mem[$1]; }
| VAR '=' expr { $$ = mem[$1] = $3; }
| expr '+' expr { $$ = $1 + $3; }
| expr '-' expr { $$ = $1 - $3; }
| expr '*' expr { $$ = $1 * $3; }
| expr '/' expr {
if ($3 == 0.0)
execerror("division by zero", "");
$$ = $1 / $3;
}
| '(' expr ')' { $$ = $2; }
| '-' expr %prec UNARYMINUS { $$ = -$2; }
;
%%
/* end of grammar */
#include
#include
char *progname;
int lineno = 1;
#include
#include
jmp_buf begin;
main(argc, argv) /* hoc2 */
char *argv[];
{
int fpecatch();
progname = argv[0];
setjmp(begin);
signal(SIGFPE, fpecatch);
yyparse();
}
yylex() /* hoc2 */
{
int c;
while ((c=getchar()) == ' ' || c == '\t')
;
if (c == EOF)
return 0;
if (c == '.' || isdigit(c)) { /* number */
ungetc(c, stdin);
scanf("%lf", &yylval.val);
return NUMBER;
}
if (islower(c)) {
yylval.index = c - 'a'; /* ASCII only */
return VAR;
}
if (c == '\n')
lineno++;
return c;
}
yyerror(s) /* report compile-time error */
char *s;
{
warning(s, (char*)0);
}
execerror(s, t) /* recover from run-time error */
char *s, *t;
{
warning(s, t);
longjmp(begin, 0);
}
fpecatch() /* catch floating point exceptions */
{
execerror("floating point exception", (char*)0);
}
warning(s, t) /* print warning message */
char *s, *t;
{
fprintf(stderr. "%s: %s", progname, s);
if (t && *t)
fprintf(stderr, " %s , t);
fprintf(stderr, " near line %d\n", lineno);
}
3.2.2
makefile
hoc2: hoc.o
cc hoc.o -o hoc2
3.3
hoc3
3.3.1
makefile
YFLAGS = -d # force creation of y.tab.h
OBJS = hoc.o init.o math.o symbol.o # abbreviation
hoc3: $(OBJS)
cc $(OBJS) -lm -o hoc3
hoc.o: hoc.h
init.o symbol.o: hoc.h y.tab.h
pr:
@pr hoc.y hoc.h init.c math.c symbol.c makefile
clean:
rm -f $(OBJS) y.tab.[ch]
3.3.2
hoc.h
typedef struct Symbol { /* symbol table entry */
char *name;
short type; /* VAR, BLTIN, UNDEF */
union {
double val; /* if VAR */
double (*ptr)(); /* if BLTIN */
} u;
struct Symbol *next; /* to link to another */
} Symbol;
Symbol *install(), *lookup();
3.3.3
hoc.y
%{
#include "hoc.h"
extern double Pow();
%}
%union {
double val; /* actual value */
Symbol *sym; /* symbol table pointer */
}
%token
%token
%type
%right '=' %left '+' '-'
%left '*' '/'
%left UNARYMINUS
%right /* exponentiation */
%%
list: /* nothing */
| list '\n'
| list asgn '\n'
| list expr '\n' { printf("\t%.8g\n", $2); }
| list error '\n' { yyerrok; }
;
asgn: VAR '=' expr { $$=$1->u.val=$3; $1->type = VAR; }
;
expr: NUMBER
| VAR { if ($l->type == UNDEF)
execerror("undefined variable", $1->name);
$$ = $1->u.val;
}
| asgn
| BLTIN '(' expr ')' { $$ = (*($1->u.ptr))($3); }
| expr '+' expr { $$ = $1 + $3; }
| expr '-' expr { $$ = $1 - $3; }
| expr '*' expr { $$ = $1 * $3; }
| expr '/' expr {
if ($3 == 0.0)
execerror("division by zero", "");
$$ = $1 / $3;
}
| expr '^' expr { $$ = Pow($1, $3); }
| '(' expr ')' { $$ = $2; }
| '-' expr %prec UNARYMINUS { $$ = -$2; }
;
%%
/* end of grammar */
#include
#include
char *progname;
int lineno = 1;
#include
#include
jmp_buf begin;
main(argc, argv) /* hoc3 */
char *argv[];
{
int fpecatch();
progname = argv[0];
init();
setjmp(begin);
signal(SIGFPE, fpecatch);
yyparse();
}
yylex() /* hoc3 */
{
int c;
while ((c=getchar()) == ' ' || c == '\t')
;
if (c == EOF)
return 0;
if (c == '.' || isdigit(c)) {
/* number */
ungetc(c, stdin);
scanf("%lf", &yylval.val);
return NUMBER;
}
if (isalpha(c)) {
Symbol *s;
char sbuf[100], *p = sbuf;
do {
*p++ = c;
} while ((c=getchar()) != EOF && isalnum(c));
ungetc(c, stdin);
*p = '\0';
if ((s=lookup(sbuf)) == 0)
s = install(sbuf, UNDEF, 0.0);
yylval.sym = s;
return s->type == UNDEF ? VAR : s->type;
}
if (c == '\n')
lineno++;
return c;
}
yyerror(s)
char *s;
{
warning(s, (char *)0);
}
execerror(s, t) /* recover from run-time error */
char *s, *t;
{
warning(s, t);
longjmp(begin, 0);
}
fpecatch() /* catch floating point exceptions */
execerror("floating point exception", (char*)0);
}
warning(s, t)
char *s, *t;
{
fprintf(stderr, "%s: %s", progname, s);
if (t && *t)
fprintf (stderr, " %s", t);
fprintf(stderr, " near line %d\n", lineno);
}
3.3.4
init.c
#include "hoc.h"
#include "y.tab.h"
#include
extern double Log(), Log10(), Exp(), Sqrt(), integer();
static struct { /* Constants */
char *name;
double eval;
} consts[] = {
"PI", 3.14159265358979323846,
"E", 2.71828182845904523536,
"GAMMA", 0.57721566490153286060, /* Euler */
"DEG", 57.29577951308232087680, /* deg/radian */
"PHI", 1.61803398874989484820, /* golden ratio */
0, 0
};
static struct { /* Built-ins */
char *name;
double (*func)();
} builtins[] = {
"sin", sin,
"cos", cos,
"atan", atan,
"log", Log, /* checks argument */
"log10", Log10, /* checks argument */
"exp", Exp, /* checks argument */
"sqrt", Sqrt, /* checks argument */
"int", integer,
"abs", fabs,
0, 0
};
init() /* install constants and built-ins in table */
{
int i;
Symbol *s;
for (i = 0; consts[i].name; i++)
install(consts[i].name, VAR, consts[i].eval);
for (i = 0; builtins[i].name; i++) {
s = install(builtins[i].name, BLTIN, 0.0);
s->u.ptr = builtins[i].func;
}
}
3.3.5
math.c
#include
#include
extern int errno;
double errcheck();
double Log(x)
double x;
{
return errcheck(log(x), "log");
}
double Log10(x)
double x;
{
return errcheck(log10(x), "log10");
}
double Sqrt(x)
double x;
{
return errcheck(sqrt(x), "sqrt");
}
double Exp(x)
double x;
{
return errcheck(exp(x), "exp");
}
double Pow(x, y)
double x, y;
return errcheck(pow(x,y), "exponentiation");
}
double integer(x)
double x;
{
return (double)(long)x;
}
double errcheck(d, s) /* check result of library call */
double d;
char *s;
{
if (errno == EDOM) {
errno = 0;
execerror(s, "argument out of domain");
}
else if (errno == ERANGE) {
errno = 0;
execerror(s, "result out of range");
}
return d;
}
3.3.6
symbol.c
#include "hoc.h"
#include "y.tab.h"
static Symbol *symlist = 0; /* symbol table: linked list */
Symbol *lookup(s) /* find s in symbol table */
char *s;
{
Symbol *sp;
for (sp = symlist; sp != (Symbol*)0; sp = sp->next)
if (strcmp(sp->name, s) == 0)
return sp;
return 0; /* 0 ==> not found */
}
Symbol *install(s, t, d) /* install s in symbol table */
char *s;
int t;
double d;
Symbol *sp;
char *emalloc();
sp = (Symbol*)emalloc(sizeof(Symbol));
sp->name = emalloc(strlen(s)+1); /* +1 for '\0' */
strcpy(sp->name, s);
sp->type = t;
sp->u.val = d;
sp->next = symlist; /* put at front of list */
symlist = sp;
return sp;
}
char *emalloc(n) /* check return from malloc */
unsigned n;
{
char *p, *malloc();
p = malloc(n);
if (p == 0)
execerror("out of memory", (char*)0);
return p;
}
3.4
hoc3
с
lex
3.4.1.
hoc.h
typedef struct Symbol { /* symbol table entry */
char *name;
short type; /* VAR, BLTIN, UNDEF */
union {
double val; /* if VAR */
double (*ptr)(); /* if BLTIN */
} u;
struct Symbol *next; /* to link to another */
} Symbol;
Symbol *install(), *lookup();
3.4.2
hoc.y
%{
#include "hoc.h"
extern double Pow();
%}
%union {
double val; /* actual value */
Symbol *sym; /* symbol table pointer */
}
%token
%token
%type
%right '='
%left '+' '-'
%left '*' '/'
%left UNARYMINUS
%right '^' /* exponentiation */
%%
list: /* nothing */
| list '\n'
| list asgn '\n'
| list expr '\n' { printf("\t%.8g\n", $2); }
| list error '\n' { yyerrok; }
;
asgn: VAR '=' expr { $$=$1->u.val=$3; $1->type = VAR; }
;
expr: NUMBER
| VAR {
if ($1->type == UNDEF)
execerror("undefined variable", $1->name);
$$ = $1->u.val;
}
| asgn
| BLTIN '(' expr ')' { $$ = (*($1->u.ptr))($3); }
| expr '+' expr { $$ = $1 + $3; }
| expr '+' expr { $$ = $1 - $3; }
| expr '*' expr { $$ = $1 * $3; }
| expr '/' expr {
if ($3 == 0.0)
execerror("division by zero", "");
$$ = $1 / $3;
}
| expr '^' expr { $$ = Pow($1, $3); }
| '(' expr ')' { $$ = $2; }
| '-' expr %prec UNARYMINUS { $$ = -$2; }
;
%%
/* end of grammar */
#include
#include
char *progname;
int lineno = 1;
#include
jmp_buf begin;
main(argc, argv) /* hoc3 */
char *argv[];
{
progname = argv[0];
init();
setjmp(begin);
yyparse();
}
yyerror(s)
char *s;
{
warning(s, (char *)0);
}
execerror(s, t)
char *s, *t;
{
warning(s, t);
longjmp(begin, 0);
}
warning(s, t)
char *s, *t;
{
fprintf (stderr, "%s: %s", progname, s);
if (t && *t)
fprintf(stderr, " %s", t);
fprintf(stderr, " near line %d\n", lineno);
}
3.4.3
init.c
#include "hoc.h"
#include "y.tab.h"
#include
extern double Log(), Log10(), Exp(), Sqrt(), integer();
static struct { /* Constants */
char *name;
double eval;
} consts [] = {
"PI", 3.14159265358979323846,
"E", 2.71828182845904523536,
"GAMMA", 0.57721566490153286060, /* Euler */
"DEG", 57.29577951308232087680, /* deg/radian */
"PHI", 1.61803398874989484820, /* golden ratio */
0, 0
};
static struct { /* Built-ins */
char *name;
double (*func)();
} builtins[] = {
"sin", sin,
"cos", cos,
"atan", atan,
"log", Log, /* checks argument */
"log10", Log10, /* checks argument */
"exp", Exp, /* checks argument */
"sqrt", Sqrt, /* checks argument */
"int", integer,
"abs", fabs,
0, 0
};
init() /* install constants and built-ins in table */
{
int i;
Symbol *s;
for (i = 0; consts[i].name; i++)
install(consts[i].name, VAR, consts[i].eval);
for (i = 0; builtins[i].name; i++) {
s = install(builtins[i].name, BLTIN, 0.0);
s->u.ptr = builtins[i].func;
}
}
3.4.4.
lex.l
%{
#include "hoc.h"
#include "y.tab.h"
extern int lineno;
%}
%%
[ \t] { ; } /* skip blanks and tabs */
[0-9]+\.?|[0-9][0-9]+ {
sscanf(yytext, "%lf", &yylval.val);
return NUMBER;
}
[a-zA-Z][a-zA-Z0-9]* {
Symbol *s;
if ((s=lookup(yytext)) == 0)
s = install(yytext, UNDEF, 0.0);
yylval.sym = s;
return s->type == UNDEF ? VAR : s->type;
}
\n {
lineno++;
return '\n';
} /* everything else */
. { return yytext[0]; }
3.4.5
makefile
YFLAGS = -d
OBJS = hoc.o lex.o init.o math.o symbol.o
hoc3: $(OBJS)
cc $(OBJS) -lm -ll -o hoc3
hoc.o: hoc.h
lex.o init.o symbol.o: hoc.h y.tab.h
3.4.6
math.c
#include
#include
extern int errno;
double errcheck();
double Log(x)
double x;
{
return errcheck(log(x), "log");
}
double Log10(x)
double x;
{
return errcheck(log10(x), "log10");
}
double Sqrt(x)
double x;
{
return errcheck(sqrt(x), "sqrt");
}
double Exp(x)
double x;
{
return errcheck(exp(x), "exp");
}
double Pow(x, y)
double x, y;
{
return errcheck(pow(x,y), "exponentiation");
}
double integer(x)
double x;
{
return (double)(long)x;
}
double errcheck(d, s) /* check result of library call */
double d;
char *s;
{
if (errno == EDOM) {
errno = 0;
execerror(s, "argument out of domain");
} else if (errno == ERANGE) {
errno = 0;
execerror(s, "result out of range");
}
return d;
}
3.4.7
symbol.c
#include "hoc.h"
#include "y.tab.h"
static Symbol *symlist =0; /* symbol table: linked list */
Symbol *lookup(s) /* find s in symbol table */
char *s;
{
Symbol *sp;
for (sp = symlist; sp != (Symbol*)0; sp = sp->next)
if (strcmp(sp->name, s) == 0)
return sp;
return 0; /* 0 ==> not found */
}
Symbol *install(s, t, d) /* install s in symbol table */
char *s;
int t;
double d;
{
Symbol *sp;
char *emalloc();
sp = (Symbol*)emalloc(sizeof(Symbol));
sp->name = emalloc(strlen(s)+1); /* +1 for '\0' */
strcpy(sp->name, s);
sp->type = t;
sp->u.val = d;
sp->next = symlist; /* put at front of list */
symlist = sp;
return sp;
}
char *emalloc(n) /* check return from malloc */
unsigned n;
{
char *p, *malloc();
p = malloc(n);
if (p == 0)
execerror("out of memory", (char*)0);
return p;
}
3.5
hoc4
3.5.1
code.c
#include "hoc.h"
#include "y.tab.h"
#define NSTACK 256
static Datum stack[NSTACK]; /* the stack */
static Datum *stackp; /* next free spot on stack */
#define NPROG 2000
Inst prog[NPROG]; /* the machine */
Inst *progp; /* next free spot for code generation */
Inst *pc; /* program counter during execution */
initcode() /* initialize for code generation */
{
stackp = stack;
progp = prog;
}
push(d) /* push d onto stack */
Datum d;
{
if (stackp >= &stack[NSTACK])
execerror("stack overflow", (char*)0);
*stackp++ = d;
}
Datum pop() /* pop and return top elem from stack */
{
if (stackp <= stack)
execerror("stack underflow", (char*)0);
return *--stackp;
}
constpush() /* push constant onto stack */
{
Datum d;
d.val = ((Symbol*)*pc++)->u.val;
push(d);
}
varpush() /* push variable onto stack */
{
Datum d;
d.sym = (Symbol*)(*pc++);
push(d);
}
bltin() /* evaluate built-in on top of stack */
{
Datum d;
d = pop();
d.val = (*(double(*)())(*pc++))(d.val);
push(d);
}
eval() /* evaluate variable on stack */
{
Datum d;
d = pop() ;
if (d.sym->type == UNDEF)
execerror("undefined variable", d.sym->name);
d.val = d.sym->u.val;
push(d);
}
add() /* add top two elems on stack */
{
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val += d2.val;
push(d1);
}
sub() /* subtract top of stack from next */
{
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val -= d2.val;
push(d1);
}
mul() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val *= d2.val;
push(d1);
}
div() {
Datum d1, d2;
d2 = pop();
if (d2.val == 0.0)
execerror("division by zero", (char*)0);
d1 = pop();
d1.val /= d2.val;
push(d1);
}
negate() {
Datum d;
d = pop();
d.val = -d.val;
push(d);
}
power() {
Datum d1, d2;
extern double Pow();
d2 = pop();
d1 = pop();
d1.val = Pow(d1.val, d2.val);
push(d1);
}
assign() /* assign top value to next value */
{
Datum d1, d2;
d1= pop();
d2 = pop();
if (d1.sym->type != VAR && d1.sym->type != UNDEF)
execerror("assignment to non-variable", d1.sym->name);
d1.sym->u.val = d2.val;
d1.sym->type = VAR;
push(d2);
}
print() /* pop top value from stack, print it */
{
Datum d;
d = pop();
printf("\t%8g\n", d.val);
}
Inst *code(f) /* install one instruction or operand */
Inst f;
{
Inst *oprogp = progp;
if (progp >= &eprog[NPROG])
execerror("program too big", (char*)0);
*progp++ = f;
return oprogp;
}
execute(p) /* run the machine */
Inst *p;
{
for (pc = p; *pc != STOP; )
(*(*pc++))();
}
3.5.2
hoc.h
typedef struct Symbol { /* symbol table entry */
char *name;
short type; /* VAR, BLTIN, UNDEF */
union {
double val; /* if VAR */
double (*ptr)(); /* if BLTIN */
} u;
struct Symbol *next; /* to link to another */
} Symbol;
Symbol *install(), *lookup();
typedef union Datum { /* interpreter stack type */
double val;
Symbol *sym;
} Datum;
extern Datum pop();
typedef int (*Inst)(); /* machine instruction */
#define STOP (Inst)0
extern Inst prog[];
extern eval(), add(), sub(), mul(), div(), negate(), power();
extern assign(), bltin(), varpush(), constpush(), print();
3.5.3
hoc.y
%{
#include "hoc.h"
#define code2(c1,c2) code(c1); code(c2)
#define code3(c1,c2,c3) code(c1); code(c2); code(c3)
%}
%union {
Symbol *sym; /* symbol table pointer */
Inst *inst; /* machine instruction */
}
%token
%right '='
%left '+' '-'
%left '*' '/'
%left UNARYMINUS
%right '^' /* exponentiation */
%%
list: /* nothing */
| list '\n'
| list asgn '\n' { code2(pop, STOP); return 1; }
| list expr '\n' { code2(print, STOP); return 1; }
| list error '\n' { yyerrok; }
;
asgn: VAR '=' expr { code3(varpush,(Inst)$1.assign); }
;
expr: NUMBER { code2(constpush, (Inst)$1); }
| VAR { code3(varpush, (Inst)$1, eval); }
| asgn
| BLTIN '(' expr ')' { code2(bltin, (Inst)$1->u.ptr); }
| '(' expr ')'
| expr '+' expr { code(add); }
| expr '-' expr { code(sub); }
| expr '*' expr { code(mul); }
| expr '/' expr { code(div); }
| expr '^' expr { code(power); }
| '-' expr %prec UNARYMINUS { code(negate); }
;
%%
/* end of grammar */
#include
#include
char *progname;
int lineno = 1;
#include
#include
jmp_buf begin;
main(argc, argv) /* hoc4 */
char *argv[];
{
int fpecatch();
progname = argv[0];
init();
setjmp(begin);
signal(SIGFPE, fpecatch);
for (initcode(); yyparse(); initcode())
execute(prog);
return 0;
}
static int c; /* global for use by warning() */
yylex() /* hoc4 */
{
while ((c=getchar()) == ' ' || с == '\t')
;
if (c == EOF)
return 0;
if (c == '.' || isdigit(c)) { /* number */
double d;
ungetc(c, stdin);
scanf ("%lf", &d);
yylval.sym = install("", NUMBER, d);
return NUMBER;
}
if (isalpha(c)) {
Symbol *s;
char sbuf[100], *p = sbuf;
do {
*p++ = c;
} while ((c=getchar()) != EOF && isalnum(c));
ungetc(c, stdin);
*p = '\0';
if ((s=lookup(sbuf)) == 0)
s = install(sbuf, UNDEF, 0.0);
yylval.sym = s;
return s->type == UNDEF ? VAR : s->type;
}
if (c == '\n')
lineno++;
return c;
}
yyerror(s)
char *s;
{
warning(s, (char *)0);
}
execerror(s, t) /* recover from run-time error */
char *s, *t;
{
warning(s, t);
longjmp(begin, 0);
}
fpecatch() /* catch floating point exceptions */
{
execerror("floating point exception", (char*)0);
}
warning(s, t)
char *s, *t;
{
fprintf(stderr, "%s: %s", progname, s);
if (t && *t)
fprintf(stderr, " %s", t);
fprintf(stderr, " near line %d\n", lineno);
while (c != '\n' && с != EOF)
с = getchar(); /* flush rest of input line */
}
3.5.4
init.c
#include "hoc.h"
#include "y.tab.h"
#include
extern double Log(), Log10(), Exp(), Sqrt(), integer();
static struct { /* Constants */
char *name;
double eval;
} consts[] = {
"PI", 3.14159265358979323846,
"E", 2.71828182845904523536,
"GAMMA", 0.57721566490153286060, /* Euler */
"DEG", 57.29577951308232087680, /* deg/radian */
"PHI", 1.61803398874989484820, /* golden ratio */
0, 0
};
static struct { /* Built-ins */
char *name;
double (*func)();
} builtins [] = {
"sin", sin,
"cos", cos,
"atan", atan,
"log", Log, /* checks argument */
"log10", Log10, /* checks argument */
"exp", Exp, /* checks argument */
"sqrt", Sqrt, /* checks argument */
"int", integer,
"abs", fabs,
0, 0
};
init() /* install constants and built-ins in table */
{
int i;
Symbol *s;
for (i = 0; consts[i].name; i++)
install(consts[i].name, VAR, consts[i].eval);
for (i = 0; builtins[i].name; i++) {
s = install(builtins[i].name, BLTIN, 0.0);
s->u.ptr = builtins[i].func;
}
}
3.5.5.
makefile
YFLAGS = -d
OBJS = hoc.o code.o init.o math.o symbol.o
hoc4: $(OBJS)
cc $(OBJS) -lm -o hoc4
hoc.o code.o init.o symbol.o: hoc.h
code.o init.o symbol.o: x.tab.h
x.tab.h: y.tab.h
-cmp -s x.tab.h y.tab.h || cp y.tab.h x.tab.h
pr: hoc.y hoc.h code.c init.c math.c symbol.c
@pr $?
@touch pr
clean:
rm -f $(OBJS) [xy].tab.[ch]
3.5.6.
math.c
#include
#include
extern int errno;
double errcheck();
double Log(x)
double x;
{
return errcheck(log(x), "log");
}
double Log10(x)
double x;
{
return errcheck(log10(x), "log10");
}
double Sqrt(x)
double x;
{
return errcheck(sqrt(x), "sqrt");
}
double Exp(x)
double x;
{
return errcheck(exp(x), "exp");
}
double Pow(x, y)
double x, y;
{
return errcheck(pow(x,y), "exponentiation");
}
double integer(x)
double x;
{
return (double)(long)x;
}
double errcheck(d, s) /* check result of library call */
double d;
char *s;
{
if (errno == EDOM) {
errno = 0;
execerror(s, "argument out of domain");
} else if (errno == ERANGE) {
errno = 0;
execerror(s, "result out of range");
}
return d;
}
3.5.7
symbol.c
#include "hoc.h"
#include "y.tab.h"
static Symbol *symlist = 0; /* symbol table: linked list */
Symbol *lookup(s) /* find s in symbol table */
char *s;
{
Symbol *sp;
for (sp = symlist; sp != (Symbol*)0; sp = sp->next)
if (strcmp(sp->name, s) == 0)
return sp;
return 0; /* 0 ==> not found */
}
Symbol *install(s, t, d) /* install s in symbol table */
char *s;
int t;
double d;
{
Symbol *sp;
char *emalloc();
sp = (Symbol*)emalloc(sizeof(Symbol));
sp->name = emalloc(strlen(s)+1); /* +1 for '\0' */
strcpy(sp->name, s);
sp->type = t;
sp->u.val = d;
sp->next = symlist; /* put at front of list */
symlist = sp;
return sp;
}
char *emalloc(n) /* check return from malloc */
unsigned n;
{
char *p, *malloc();
p = malloc(n);
if (p == 0)
execerror("out of memory", (char*)0);
return p;
}
3.6
hoc5
3.6.1
code.c
#include "hoc.h"
#include "y.tab.h"
#define NSTACK 256
static Datum stack[NSTACK];
static Datum *stackp;
#define NPROG 2000
Inst prog[NPROG];
static Inst *pc;
Inst *progp;
initcode() {
progp = prog;
stackp = stack;
}
push(d)
Datum d;
{
if (stackp >= &stack[NSTACK])
execerror("stack too deep", (char*)0);
*stackp++ = d;
}
Datum pop() {
if (stackp == stack)
execerror("stack underflow", (char*)0);
return *--stackp;
}
constpush() {
Datum d;
d.val = ((Symbol*)*pc++)->u.val;
push(d);
}
varpush() {
Datum d;
d.sym = (Symbol*)(*pc++);
push(d);
}
whilecode() {
Datum d;
Inst *savepc = pc; /* loop body */
execute(savepc+2); /* condition */
d = pop();
while (d.val) {
execute (*((Inst**)(savepc))); /* body */
execute(savepc+2);
d = pop();
}
pc = *((Inst**)(savepc+1)); /* next statement */
}
ifcode() {
Datum d;
Inst *savepc = pc; /* then part */
execute(savepc+3); /* condition */
d = pop();
if (d.val)
execute(*((Inst**)(savepc)));
else if (*((Inst**)(savepc+1))) /* else part? */
execute(*((Inst**)(savepc+1)));
pc = *((Inst**)(savepc+2)); /* next stmt */
}
bltin() {
Datum d;
d = pop();
d.val = (*(double(*)())(*pc++))(d.val);
push(d);
}
eval() /* Evaluate variable on stack */ {
Datum d;
d = pop();
if (d.sym->type != VAR && d.sym->type != UNDEF)
execerror("attempt to evaluate non-variable", d.sym->name);
if (d.sym->type == UNDEF)
execerror("undefined variable", d.sym->name);
d.val = d.sym->u.val;
push(d);
}
add() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val += d2.val;
push(d1);
}
sub() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val -= d2.val;
push(d1);
}
mul() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val *= d2.val;
push(d1);
}
div() {
Datum d1, d2;
d2 = pop();
if (d2.val == 0.0)
execerror("division by zero", (char*)0);
d1 = pop();
d1.val /= d2.val;
push(d1);
}
negate() {
Datum d;
d = pop();
d.val = -d.val;
push(d);
}
gt() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val > d2.val);
push(d1);
}
lt() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val < d2.val);
push(d1);
}
ge() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val >= d2.val);
push(d1);
}
le() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val <= d2.val);
push(d1);
}
eq() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val == d2.val);
push(d1);
}
ne() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val != d2.val);
push(d1);
}
and() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val != 0.0 && d2.val != 0.0);
push(d1);
}
or() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val != 0.0 || d2.val != 0.0);
push(d1);
}
not() {
Datum d;
d = pop();
d.val = (double)(d.val == 0.0);
push(d);
}
power() {
Datum d1, d2;
extern double Pow();
d2 = pop();
d1 = pop();
d1.val = Pow(d1.val, d2.val);
push(d1);
}
assign() {
Datum d1, d2;
d1 = pop();
d2 = pop();
if (d1.sym->type != VAR && d1.sym->type != UNDEF)
execerror("assignment to non-variable", d1.sym->name);
d1.sym->u.val = d2.val;
d1.sym->type = VAR;
push(d2);
}
print() {
Datum d;
d = pop();
printf("\t%.8g\n", d.val);
}
prexpr() /* print numeric value */
{
Datum d;
d = pop();
printf("%.8g\n", d.val);
}
Inst *code(f) /* install one instruction or operand */
Inst f;
{
Inst *oprogp = progp;
if (progp >= &prog[NPROG])
execerror("expression too complicated", (char*)0);
*progp++ = f;
return oprogp;
}
execute(p)
Inst *p;
{
for (pc = p; *pc != STOP; ) (*(*pc++))();
}
3.6.2
fib
{
a=0
b=1
while(b<1000) {
c=b
b=a+b
a=c
print(c)
}
}
3.6.3
fib2
{
n=0
a=0
b=1
while(b<10000000){
n=n+1
c=b
b=a+b
a=c
print(b)
}
print(n)
}
3.6.4
hoc.h
typedef struct Symbol { /* symbol table entry */
char *name;
short type; /* VAR, BLTIN, UNDEF */
union {
double val; /* if VAR */
double (*ptr)(); /* if BLTIN */
} u;
struct Symbol *next; /* to link to another */
} Symbol;
Symbol *install(), *lookup();
typedef union Datum { /* interpreter stack type */
double val;
Symbol *sym;
} Datum;
extern Datum pop();
typedef int (*Inst)(); /* machine instruction */
#define STOP (Inst)0
extern Inst prog[], *progp, *code();
extern eval(), add(), sub(), mul(), div(), negate(), power();
extern assign(), bltin(), varpush(), constpush(), print();
extern prexpr();
extern gt(), lt(), eq(), ge(), le(), ne(), and(), or(), not();
extern ifcode(), whilecode();
3.6.5
hoc.y
%{
#include "hoc.h"
#define code2(c1,c2) code(c1); code(c2)
#define code3(c1,c2,c3) code(c1); code(c2); code(c3)
%}
%union {
Symbol *sym; /* symbol table pointer */
Inst *inst; /* machine instruction */
}
%token
%type
%right '='
%left OR
%left AND
%left GT GE LT LE EQ NE
%left '+' '-'
%left '*' '/'
%left UNARYMINUS NOT
%right
%%
list: /* nothing */
| list '\n'
| list asgn '\n' { code2(pop, STOP); return 1; }
| list stmt '\n' { code(STOP); return 1; }
| list expr '\n' { code2(print, STOP); return 1; }
| list error '\n' { yyerrok; }
;
asgn: VAR '=' expr { $$=$3; code3(varpush,(Inst)$1.assign); }
;
stmt: expr { code(pop); }
| PRINT expr { code(prexpr); $$ = $2; }
| while cond stmt end {
($1)[1] = (Inst)$3; /* body of loop */
($1)[2] = (Inst)$4;
} /* end, if cond fails */
| if cond stmt end { /* else-less if */
($1)[1] = (Inst)$3; /* thenpart */
($1)[2] = (Inst)$4;
} /* end, if cond fails */
| if cond stmt end ELSE stmt end { /* if with else */
($1)[1] = (Inst)$3; /* thenpart */
($1)[2] = (Inst)$6; /* elsepart */
($1)[3] = (Inst)$7;
} /* end, if cond fails */
| '{' stmtlist '}' { $$ = $2; }
;
cond: '(' expr ')' { code(STOP); $$ = $2; }
;
while: WHILE { $$ = code3(whilecode, STOP, STOP); }
;
if: IF { $$=code(ifcode); code3(STOP, STOP, STOP); }
;
end: /* nothing */ { code(STOP); $$ = progp; }
;
stmtlist: /* nothing */ { $$ = progp; }
| stmtlist '\n'
| stmtlist stmt
;
expr: NUMBER { $$ = code2(constpush, (Inst)$1); }
| VAR { $$ = code3(varpush, (Inst)$1, eval); }
| asgn
| BLTIN '(' expr ')'
{ $$ = $3; code2(bltin,(Inst)$1->u.ptr); }
| '(' expr ')' { $$ = $2; }
| expr '+' expr { code(add); }
| expr '-' expr { code(sub); }
| expr '*' expr { code(mul); }
| expr '/' expr { code(div); }
| expr '^' expr { code (power); }
| '-' expr %prec UNARYMINUS { $$ = $2; code(negate); }
| expr GT expr { code(gt); }
| expr GE expr { code(ge); }
| expr LT expr { code(lt); }
| expr LE expr { code(le); }
| expr EQ expr { code(eq); }
| expr NE expr { code(ne); }
| expr AND expr { code(and); }
| expr OR expr { code(or); }
| NOT expr { $$ = $2; code(not); }
;
%%
/* end of grammar */
#include
#include
char *progname;
int lineno = 1;
#include
#include
jmp_buf begin;
int defining;
int c; /* global for use by warning() */
yylex() /* hoc5 */
{
while ((c=getchar()) == ' ' || c == '\t')
;
if (c == EOF)
return 0;
if (c == '.' || isdigit(c)) { /* number */
double d;
ungetc(c, stdin);
scanf("%lf", &d);
yylval.sym = install("", NUMBER, d);
return NUMBER;
}
if (isalpha(c)) {
Symbol *s;
char sbuf[100], *p = sbuf;
do
*p++ = c;
while ((c=getchar()) != EOF && isalnum(c));
ungetc(c, stdin);
*p = '\0';
if ((s=lookup(sbuf)) == 0)
s = install(sbuf, UNDEF, 0.0);
yylval.sym = s;
return s->type == UNDEF ? VAR : s->type;
}
switch (c) {
case '>': return follow('=', GE, GT);
case '<': return follow('=', LE, LT);
case '=': return follow('=', EQ, '=');
case '!': return follow('=', NE, NOT);
case '|': return follow('|', OR, '|');
case '&': return follow('&', AND, '&');
case '\n': lineno++; return '\n';
default: return c;
}
}
follow(expect, ifyes, ifno) /* look ahead for >=, etc. */
{
int c = getchar();
if (c == expect)
return ifyes;
ungetc(c, stdin);
return ifno;
}
yyerror(s)
char *s;
{
warning(s, (char*)0);
}
execerror(s, t) /* recover from run-time error */
char *s, *t;
{
warning(s, t);
longjmp(begin, 0);
}
fpecatch() /* catch floating point exceptions */
{
execerror("floating point exception", (char*)0);
}
main(argc, argv)
char *argv[];
{
int fpecatch();
progname = argv[0];
init();
setjmp(begin);
signal(SIGFPE, fpecatch);
for (initcode(); yyparse(); initcode())
execute(prog);
return 0;
}
warning(s, t)
char *s, *t;
{
fprintf(stderr, "%s: %s", progname, s);
if (t && *t)
fprintf(stderr, " %s", t);
fprintf(stderr, " near line %d\n", lineno);
while (c != '\n' && с != EOF)
c = getchar(); /* flush rest of input line */
fseek(stdin, 0L, 2); /* flush rest of file */
longjmp(begin, 0);
}
3.6.6
init.c
#include "hoc.h"
#include "y.tab.h"
#include
extern double Log(), Log10(), Sqrt(), Exp(), integer();
static struct { /* Keywords */
char *name;
int kval;
} keywords[] = {
"if", IF,
"else", ELSE,
"while", WHILE,
"print", PRINT,
0, 0,
};
static struct { /* Constants */
char *name;
double eval;
} consts[] = {
"PI", 3.14159265358979323846,
"E", 2.71828182845904523536,
"GAMMA", 0.57721566490153286060, /* Euler */
"DEG", 57.29577951308232087680, /* deg/radian */
"PHI", 1.61803398874989484820, /* golden ratio */
0, 0
};
static struct { /* Built-ins */
char *name;
double (*func)();
} builtins[] = {
"sin", sin,
"cos", cos,
"atan", atan,
"log", Log, /* checks argument */
"log10", Log10, /* checks argument */
"exp", exp,
"sqrt", Sqrt, /* checks argument */
"int", integer,
"abs", fabs,
0, 0
};
init() /* install constants and built-ins in table */
{
int i;
Symbol *s;
for (i = 0; keywords[i].name; i++)
install(keywords[i].name, keywords[i].kval, 0.0);
for (i = 0; consts[i].name; i++)
install(consts[i].name, VAR, consts[i].eval);
for (i = 0; builtins[i].name; i++) {
s = install(builtins[i].name, BLTIN, 0.0);
s->u.ptr = builtins[i].func;
}
}
3.6.7
makefile
YFLAGS = -d
OBJS = hoc.o code.o init.o math.o symbol.o
hoc5: $(OBJS)
cc $(OBJS) -lm -o hoc5
hoc.o code.o init.o symbol.o: hoc.h
code.o init.o symbol.o: x.tab.h
x.tab.h: y.tab.h
-cmp -s x.tab.h y.tab.h || cp y.tab.h x.tab.h
pr: hoc.y hoc.h code.c init.c math.c symbol.c
@pr $?
@touch pr
clean:
rm -f $(OBJS) [xy].tab.[ch]
3.6.8
math.c
#include
#include
extern int errno;
double errcheck();
double Log(x)
double x;
{
return errcheck(log(x), "log");
}
double Log10(x)
double x;
{
return errcheck(log10(x), "log10");
}
double Sqrt(x)
double x;
{
return errcheck(sqrt(x), "sqrt");
}
double Exp(x)
double x;
{
return errcheck(exp(x), "exp");
}
double Pow(x, y)
double x, y;
{
return errcheck(pow(x,y), "exponentiation");
}
double integer(x)
double x;
{
return (double)(long)x;
}
double errcheck(d, s) /* check result of library call */
double d;
char *s;
{
if (errno == EDOM) {
errno = 0;
execerror(s, "argument out of domain");
} else if (errno == ERANGE) {
errno = 0;
execerror(s, "result out of range");
}
return d;
}
3.6.9
symbol.c
#include "hoc.h"
#include "y.tab.h"
static Symbol *symlist =0; /* symbol table: linked list */
Symbol *lookup(s) /* find s in symbol table */
char *s;
{
Symbol *sp;
for (sp = symlist; sp != (Symbol*)0; sp = sp->next)
if (strcmp(sp->name, s) == 0)
return sp;
return 0; /* 0 ==> not found */
}
Symbol *install(s, t, d) /* install s in symbol table */
char *s;
int t;
double d;
{
Symbol *sp;
char *emalloc();
sp = (Symbol*)emalloc(sizeof(Symbol));
sp->name = emalloc(strlen(s)+1); /* +1 for '\0' */
strcpy(sp->name, s);
sp->type = t;
sp->u.val = d;
sp->next = symlist; /* put at front of list */
symlist = sp;
return sp;
}
char *emalloc(n) /* check return from malloc */
unsigned n;
{
char *p, *malloc();
p = malloc(n);
if (p == 0)
execerror("out of memory", (char*)0);
return p;
}
3.7
hoc6
3.7.1
ack
func ack() {
n = n+1
if ($1 == 0) return ($2+1)
if ($2 == 0) return (ack($1 - 1, 1))
return (ack($1 - 1, ack($1, $2 - 1)))
}
n=0
ack(3,3)
print n, "calls\n"
3.7.2
ack1
func ack() {
n = n+1
if ($1 == 0) return ($2+1)
if ($2 == 0) return (ack($1 - 1, 1))
return (ack($1 - 1, ack($1, $2 - 1)))
}
n=0
while (read(x)) {
read(y)
print ack(x,y), "\n"
}
print n,"\n"
3.7.3
code.c
#include "hoc.h"
#include "y.tab.h"
#include
#define NSTACK 256
static Datum stack[NSTACK]; /* the stack */
static Datum *stackp; /* next free spot on stack */
#define NPROG 2000
Inst prog[NPROG]; /* the machine */
Inst *progp; /* next free spot for code generation */
Inst *pc; /* program counter during execution */
Inst *progbase = prog; /* start of current subprogram */
int returning; /* 1 if return stmt seen */
typedef struct Frame { /* proc/func call stack frame */
Symbol *sp; /* symbol table entry */
Inst *retpc; /* where to resume after return */
Datum *argn; /* n-th argument on stack */
int nargs; /* number of arguments */
} Frame;
#define NFRAME 100
Frame frame[NFRAME];
Frame *fp; /* frame pointer */
initcode() {
progp = progbase;
stackp = stack;
fp = frame;
returning = 0;
}
push(d)
Datum d;
{
if (stackp >= &stack[NSTACK])
execerror("stack too deep", (char*)0);
*stackp++ = d;
}
Datum pop() {
if (stackp == stack)
execerror("stack underflow", (char*)0);
return *--stackp;
}
constpush() {
Datum d;
d.val = ((Symbol*)*pc++)->u.val;
push(d);
}
varpush() {
Datum d;
d.sym = (Symbol*)(*pc++);
push(d);
}
whilecode() {
Datum d;
Inst *savepc = pc;
execute(savepc+2); /* condition */
d = pop();
while (d.val) {
execute(*((Inst**)(savepc))); /* body */
if (returning)
break;
execute(savepc+2); /* condition */
d = pop();
}
if (!returning)
pc = *((Inst**)(savepc+1)); /* next stmt */
}
ifcode() {
Datum d;
Inst *savepc = pc; /* then part */
execute(savepc+3); /* condition */
d = pop();
if (d.val)
execute(*((Inst**)(savepc)));
else if (*((Inst**)(savepc+1))) /* else part? */
execute(*((Inst**)(savepc+1)));
if (!returning)
pc = *((Inst**)(savepc+2)); /* next stmt */
}
define(sp) /* put func/proc in symbol table */
Symbol *sp;
{
sp->u.defn = (Inst)progbase; /* start of code */
progbase = progp; /* next code starts here */
}
call() /* call a function */
{
Symbol *sp = (Symbol*)pc[0]; /* symbol table entry */
/* for function */
if (fp++ >= &frame[NFRAME-1])
execerror(sp->name, "call nested too deeply");
fp->sp = sp;
fp->nargs = (int)pc[1];
fp->retpc = pc + 2;
fp->argn = stackp - 1; /* last argument */
execute(sp->u.defn);
returning = 0;
}
ret() /* common return from func or proc */
{
int i;
for (i = 0; i < fp->nargs; i++)
pop(); /* pop arguments */
pc = (Inst*)fp->retpc;
--fp;
returning = 1;
}
funcret() /* return from a function */
{
Datum d;
if (fp->sp->type == PROCEDURE)
execerror(fp->sp->name, "(proc) returns value");
d = pop(); /* preserve function return value */
ret();
push(d);
}
procret() /* return from a procedure */
{
if (fp->sp->type == FUNCTION)
execerror(fp->sp->name, "(func) returns no value");
ret();
}
double *getarg() /* return pointer to argument */
{
int nargs = (int)*pc++;
if (nargs > fp->nargs)
execerror(fp->sp->name, "not enough arguments");
return &fp->argn[nargs - fp->nargs].val;
}
arg() /* push argument onto stack */
{
Datum d;
d.val = *getarg();
push(d);
}
argassign() /* store top of stack in argument */
{
Datum d;
d = pop();
push(d); /* leave value on stack */
*getarg() = d.val;
}
bltin() {
Datum d;
d = pop();
d.val = (*(double(*)())*pc++)(d.val);
push(d);
}
eval() /* evaluate variable on stack */
{
Datum d;
d = pop();
if (d.sym->type != VAR && d.sym->type != UNDEF)
execerror("attempt to evaluate non-variable", d.sym->name);
if (d.sym->type == UNDEF)
execerror("undefined variable", d.sym->name);
d.val = d.sym->u.val;
push(d);
}
add() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val += d2.val;
push(d1);
}
sub() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val -= d2.val;
push(d1);
}
mul() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val *= d2.val;
push(d1);
}
div() {
Datum d1, d2;
d2 = pop();
if (d2.val == 0.0)
execerror("division by zero", (char *)0);
d1 = pop();
d1.val /= d2.val;
push(d1);
}
negate() {
Datum d;
d = pop();
d.val = -d.val;
push(d);
}
gt() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val > d2.val);
push(d1);
}
lt() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val < d2.val);
push(d1);
}
ge() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val >= d2.val);
push(d1);
}
le() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val <= d2.val);
push(d1);
}
eq() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val == d2.val);
push(d1);
}
ne() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val != d2.val);
push(d1);
}
and() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val != 0.0 && d2.val != 0.0);
push(d1);
}
or() {
Datum d1, d2;
d2 = pop();
d1 = pop();
d1.val = (double)(d1.val != 0.0 || d2.val != 0.0);
push(d1);
}
not() {
Datum d;
d = pop();
d.val = (double)(d.val == 0.0);
push(d);
}
power() {
Datum d1, d2;
extern double Pow();
d2 = pop();
d1 = pop();
d1.val = Pow(d1.val, d2.val);
push(d1);
}
assign() {
Datum d1, d2;
d1 = pop();
d2 = pop();
if (d1.sym->type != VAR && d1.sym->type != UNDEF)
execerror("assignment to non-variable", d1.sym->name);
d1.sym->u.val = d2.val;
d1.sym->type = VAR;
push(d2);
}
print() /* pop top value from stack, print it */
{
Datum d;
d = pop();
printf("\t%.8g\n", d.val);
}
prexpr() /* print numeric value */
{
Datum d;
d = pop();
printf("%.8g ", d.val);
}
prstr() /* print string value */
{
printf(%s", (char*)*pc++);
}
varread() /* read into variable */
{
Datum d;
extern FILE *fin;
Symbol *var = (Symbol*)*pc++;
Again:
switch (fscanf(fin, "%lf", &var->u.val)) {
case EOF:
if (moreinput())
goto Again;
d.val = var->u.val = 0.0;
break;
case 0:
execerror("non-number read into", var->name);
break;
default:
d.val = 1.0;
break;
}
var->type = VAR;
push(d);
}
Inst *code(f) /* install one instruction or operand */
Inst f;
{
Inst *oprogp = progp;
if (progp >= &prog[NPROG])
execerror("program too big", (char*)0);
*progp++ = f;
return oprogp;
}
execute(p)
Inst *p;
{
for (pc = p; *pc != STOP && !returning; )
(*((++pc)[-1]))();
}
3.7.4
double
proc double() {
if ($1 > 1) {
double($1/2)
}
print($1)
}
double(1024)
3.7.5
fac
func fac() {
if ($1 <= 0) return 1 else return $1 * fac($1-1)
}
3.7.6
fac1
func fac() if ($1 <= 0) return 1 else return $1 * fac($1-1)
fac(0)
fac(7)
fac(10)
3.7.7
fac2
func fac() {
if ($1 <= 0) {
return 1
}
return $1 * fac($1-1)
}
i=0
while(i<=20){
print "factorial of ", i, "is ", fac(i), "\n"
i=i+1
}
3.7.8
fib
proc fib() {
a = 0
b = 1
while (b < $1) {
print b
c = b
b = a+b
a = c
}
print "\n"
}
3.7.9
fib2
{
n=0
a=0
b=1
while(b<10000000){
n=n+1
c=b
b=a+b
a=c
print(b)
}
print(n)
}
3.7.10
fibsum
proc fib(){
a=1
b=1
c=2
d=3
sum = a+b+c+d
while(d<$1){
e=d+c
print(e)
a=b
b=c
c=d
d=e
sum=sum+e
}
print(sum)
}
fib(1000)
3.7.11
fibtest
proc fib() {
a = 0
b = 1
while (b < $1) {
c = b
b = a+b
a = c
}
}
i = 1
while (i < 1000) {
fib(1000)
i = i + 1
}
3.7.12
hoc.h
typedef struct Symbol { /* symbol table entry */
char *name;
short type;
union {
double val; /* VAR */
double (*ptr)(); /* BLTIN */
int (*defn)(); /* FUNCTION, PROCEDURE */
char *str; /* STRING */
} u;
struct Symbol *next; /* to link to another */
} Symbol;
Symbol *install(), *lookup();
typedef union Datum { /* interpreter stack type */
double val;
Symbol *sym;
} Datum;
extern Datum pop();
extern eval(), add(), sub(), mul(), div(), negate(), power();
typedef int (*Inst)();
#define STOP (Inst)0
extern Inst *progp, *progbase, prog[], *code();
extern assign(), bltin(), varpush(), constpush(), print(), varread();
extern prexpr(), prstr();
extern gt(), lt(), eq(), ge(), le(), ne(), and(), or(), not();
extern ifcode(), whilecode(), call(), arg(), argassign();
extern funcret(), procret();
3.7.13
hoc.ms
.EQ
delim @@
.EN
.TL
Hoc - An Interactive Language For Floating Point Arithmetic
.AU
Brian Kernighan
Rob Pike
.AB
.I Hoc
is a simple programmable interpreter
for floating point expressions.
It has C-style control flow,
function definition and the usual
numerical built-in functions such as cosine and logarithm.
.AE
.NH
Expressions
.PP
.I Hoc
is an expression language,
much like C:
although there are several control-flow statements,
most statements such as assignments
are expressions whose value is disregarded.
For example, the assignment operator
= assigns the value of its right operand
to its left operand, and yields the value,
so multiple assignments work.
The expression grammar is:
.DS
.I
expr: number
| variable
| ( expr )
| expr binop expr
| unop expr
| function ( arguments )
.R
.DE
Numbers are floating point.
The input format is
that recognized by @scanf@(3):
.ix [scanf]
digits, decimal point, digits,
.ix [hoc] manual
.ix assignment expression
.ix multiple assignment
@e@ or @E@, signed exponent.
At least one digit or a decimal point
must be present;
the other components are optional.
.PP
Variable names are formed from a letter
followed by a string of letters and numbers,
@binop@ refers to binary operators such
as addition or logical comparison;
@unop@ refers to the two negation operators,
'!' (logical negation, 'not')
and '\-' (arithmetic negation, sign change).
Table 1 lists the operators.
.TS
center, box;
с s
lfCW l.
\fBTable 1:\fP Operators, in decreasing order of precedence
.sp .5
^ exponentiation (\s-1FORTRAN\s0 **), right associative
! \- (unary) logical and arithmetic negation
* / multiplication, division
+ \- addition, subtraction
> >= relational operators: greater, greater or equal,
< <= less, less or equal,
\&== != equal, not equal (all same precedence)
&& logical AND (both operands always evaluated)
|| logical OR (both operands always evaluated)
\&= assignment, right associative
.ТЕ
.ix table~of [hoc] operators
.PP
Functions, as described later, may be defined by the user.
Function arguments are expressions separated by commas.
There are also a number of built-in functions,
all of which take a single argument,
described in Table 2.
.TS
center, box;
с s
lfCW l.
\fBTable 2:\fP Built-in Functions
.sp .5
abs(x) @| x |@, absolute value of @x@
atan(x) arc tangent of @x@
cos(x) @cos (x)@, cosine of @x@
exp(x) @e sup x@, exponential of @x@
int(x) integer part of @x@, truncated towards zero
log(x) @log (x)@, logarithm base @e@ of @x@
log10(x) @log sub 10 (x)@, logarithm base 10 of @x@
sin(x) @sin (x)@, sine of @x@
sqrt(x) @sqrt x@, @x sup half@
.ТЕ
.ix table~of [hoc] functions
.PP
Logical expressions have value 1.0 (true) and 0.0 (false).
As in C,
any non-zero value is taken to be true.
As is always the case with floating point numbers,
equality comparisons are inherently suspect. .PP
.I Hoc
also has a few built-in constants, shown in Table 3.
.TS
center, box;
c s s
lfCW n l.
\fBTable 3:\fP Built-in Constants
.sp .5
DEG 57.29577951308232087680 @180/ pi@, degrees per radian
E 2.71828182845904523536 @e@, base of natural logarithms
GAMMA 0.57721566490153286060 @gamma@, Euler-Mascheroni constant
PHI 1.61803398874989484820 @( sqrt 5 +1)/2@, the golden ratio
PI 3.14159265358979323846 @pi@, circular transcendental number
.ТЕ
.ix table~of [hoc] constants
.NH
Statements and Control Flow
.PP
.I Hoc
statements have the following grammar:
.DS
.I
stmt: expr
| variable = expr
| procedure ( arglist )
| while ( expr ) stmt
| if ( expr ) stmt
| if ( expr ) stmt else stmt
| { stmtlist }
| print expr-list
| return optional-expr
stmtlist: \fR(nothing)\fI
| stmlist stmt
.R
.DE
An assignment is parsed by default as a statement rather than
an expression, so assignments typed interactively
do not print their value.
.PP
Note that semicolons are not special to
.ix [hoc] input~format
@hoc@: statements are terminated by newlines.
This causes some peculiar behavior.
The following are legal
.IT if
statements:
.DS
.ft CW
if (x < 0) print(y) else print(z)
if (x < 0) {
print(y)
} else {
print(z)
}
.ft
.DE
In the second example, the braces are mandatory:
the newline after the
.I if
would terminate the statement and produce a syntax error were
the brace omitted.
.PP
The syntax and semantics of @hoc@
control flow facilities are basically the same as in C.
The
.I while
and
.I if
statements are just as in C, except there are no @break@ or
@continue@ statements.
.NH
Input and Output: @read@ and @print@
.PP
.ix [hoc] [read]~statement
.ix [hoc] [print]~statement
The input function @read@, like the other built-ins,
takes a single argument. Unlike the built-ins, though, the argument
is not ал expression: it is the name of a variable.
The next number (as defined above) is read from the standard input
and assigned to the named variable.
The return value of @read@ is 1 (true) if a value was read, and 0 (false)
if @read@ encountered end of file or an error.
.PP
Output is generated with the ©print© statement.
The arguments to @print@ are a comma-separated list of expressions
and strings in double quotes, as in C.
Newlines must be supplied;
they are never provided automatically by @print@.
.PP
Note that @read@ is a special built-in function, and therefore takes
a single parenthesized argument, while @print@ is a statement that takes
a comma-separated, unparenthesized list:
.DS
.ft CW
while (read(x)) {
print "value is ", x, "\n"
}
.ft
.DE
.NH
Functions and Procedures
.PP
Functions and procedures are distinct in @hoc@,
although they are defined by the same mechanism.
This distinction is simply for run-time error checking:
it is an error for a procedure to return a value,
and for a function @not@ to return one.
.PP
The definition syntax is:
.ix [hoc] function~definition
.ix [hoc] procedure~definition
.DS
.I
.ta 1i
function: func name() stmt
procedure: proc name() stmt
.R
.DE
.I name
may be the name of any variable \(em built-in functions are excluded.
The definition, up to the opening brace or statement,
must be on one line, as with the
.I if
statements above.
.PP
Unlike C,
the body of a function or procedure may be any statement, not
necessarily a compound (brace-enclosed) statement.
Since semicolons have no meaning in @hoc@,
a null procedure body is formed by an empty pair of braces.
.PP
Functions and procedures may take arguments, separated by commas,
when invoked. Arguments are referred to as in the shell:
.ix [hoc] arguments
.IT $3
refers to the third (1-indexed) argument.
They are passed by value and within functions
are semantically equivalent to variables.
It is an error to refer to an argument numbered greater than the
number of arguments passed to the routine. The error checking
is done dynamically, however, so a routine may have variable numbers
of arguments if initial arguments affect the number of arguments
to be referenced (as in C's @printf@).
.PP
Functions and procedures may recurse, but the stack has limited depth
(about a hundred calls). The following shows a
.I
hoc
definition of Ackermann's function:
.ix Ackermann's~function
.DS
.ft CW
.ix [ack]~function
.S $ "hoc
.S "func ack() {
.S " if ($1 == 0) return $2+1
.S " if ($2 == 0) return ack($1-1, 1)
.S " return ack($1-1, ack($1, $2-1))
.S "}
.S "ack(3, 2)
29
.S "ack(3, 3)
61
.S "ack(3, 4)
hoc: stack too deep near line 8
\&...
.ft
.DE
.bp
.NH
Examples
.PP
Stirling's~formula:
.ix Stirling's~formula
.EQ
n! ~\(ap~ sqrt {2n pi} (n/e) sup n (1+ 1 over 12n )
.EN
.DS
.ft CW
.S $ hoc
.S "func stirl() {
.S " return sqrt(2*$1*PI) * ($1/E)"$1*(1 + 1/(12*$1)) .S "}
.S "stirl(10)
3628684.7
.S stirl(20)
2.4328818e+18
.ft R
.DE
.PP
Factorial function, @n!@:
.ix [fac]~function
.DS
. S "func fac() if ($1 <= 0) return 1 else return $1 * fac($1-1)
.ft R
.DE
.PP
Ratio of factorial to Stirling approximation:
.DS
.S "i = 9
.S "while ((i = i+1) <= 20) {
.S \ \ \ \ \ \ \ \ print\ i,\ "\ \ ",\ fac(i)/stirl(i),\ "\en"
.S "} .ft CW
10 1.0000318
11 1.0000265
12 1.0000224
13 1.0000192
14 1.0000166
15 1.0000146
16 1.0000128
17 1.0000114
18 1.0000102
19 1.0000092
20 1.0000083
.ft
.DE
3.7.14
hoc.y
%{
#include "hoc.h"
#define code2(c1,c2) code(c1); code(c2)
#define code3(c1,c2,c3) code(c1); code(c2); code(c3)
%}
%union {
Symbol *sym; /* symbol table pointer */
Inst *inst; /* machine instruction */
int narg; /* number of arguments */
}
%token
%token
%token
%type
%type
%type
%type
%right '='
%left OR
%left AND
%left GT GE LT LE EQ NE
%left '+' '-' %left '/'
%left UNARYMINUS NOT
%right '^'
%%
list: /* nothing */
| list '\n'
| list defn '\n'
| list asgn '\n' { code2(pop, STOP); return 1; }
| list stmt '\n' { code(STOP); return 1; }
| list expr '\n' { code2(print, STOP); return 1; }
| list error '\n' { yyerrok; }
;
asgn: VAR '=' expr { code3(varpush,(Inst)$1,assign); $$=$3; }
| ARG '=' expr
{ defnonly("$"); code2(argassign,(Inst)$1); $$=$3;}
;
stmt: expr { code(pop); }
| RETURN { defnonly("return"); code(procret); }
| RETURN expr
{ defnonly("return"); $$=$2; code(funcret); }
| PROCEDURE begin '(' arglist ')'
{ $$ = $2; code3(call, (Inst)$1, (Inst)$4); }
| PRINT prlist { $$ = $2; }
| while cond stmt end {
($1)UID = (Inst)$3; /* body of loop */
($1)[2] = (Inst)$4;
} /* end, if cond fails */
| if cond stmt end { /* else-less if */
($1)[1] = (Inst)$3; /* thenpart */
($1)[3] = (Inst)$4;
} /* end, if cond fails */
| if cond stmt end ELSE stmt end { /* if with else */
($1)[1] = (Inst)$3; /* thenpart */
($1)[2] = (Inst)$6; /* elsepart */
($1)[3] = (Inst)$7;
} /* end, if cond fails */
| '{' stmtlist '}' { $$ = $2; }
;
cond: '(' expr ')' { code(STOP); $$ = $2; }
;
while: WHILE { $$ = code3(whilecode,STOP,STOP); }
;
if: IF { $$ = code(ifcode); code3(STOP,STOP,STOP); }
;
begin: /* nothing */ { $$ = progp; }
;
end: /* nothing */ { code(STOP); $$ = progp; }
;
stmtlist: /* nothing */ { $$ = progp; }
| stmtlist '\n'
| stmtlist stmt
;
expr: NUMBER { $$ = code2(constpush, (Inst)$1); }
| VAR { $$ = code3(varpush, (Inst)$1, eval); }
| ARG { defnonly("$"); $$ = code2(arg, (Inst)$1); }
| asgn
| FUNCTION begin '(' arglist ');
{ $$ = $2; code3(call,(Inst)$1,(Inst)$4); }
| READ '(' VAR ')'{$$ = code2(varread, (Inst)$3); }
| BLTIN '(' expr ')' { $$=$3; code2(bltin, (Inst)$1->u.ptr); }
| '(' expr ')' { $$ = $2; }
| expr '+' expr { code(add); }
| expr '-' expr { code(sub); }
| expr '*' expr { code(mul); }
| expr '/' expr { code(div); }
| expr '^' expr { code(power); }
| '-' expr %prec UNARYMINUS { $$=$2; code(negate); }
| expr GT expr { code(gt); }
| expr GE expr { code(ge); }
| expr LT expr { code(lt); }
| expr LE expr { code(le); }
| expr EQ expr { code(eq); }
| expr NE expr { code(ne); }
| expr AND expr { code(and); }
| expr OR expr { code(or); }
| NOT expr { $$ = $2; code(not); }
;
prlist: expr { code(prexpr); }
| STRING { $$ = code2(prstr, (Inst)$1); }
| prlist expr { code(prexpr); }
| prlist STRING { code2(prstr, (Inst)$3); }
;
defn: FUNC procname { $2->type=FUNCTION; indef=1; }
'(' ')' stmt { code(procret); define($2); indef=0; }
| PROC procname { $2->type=PROCEDURE; indef=1; }
'(' ')' stmt { code(procret); define($2); indef=0; }
;
procname: VAR
| FUNCTION
| PROCEDURE
;
arglist: /* nothing */ { $$ = 0; }
| expr { $$ = 1; }
| arglist expr { $$ = $1 + 1; }
;
%%
/* end of grammar */
#include
#include
char *progname;
int lineno = 1;
#include
#include
jmp_buf begin;
int indef;
char *infile; /* input file name */
FILE *fin; /* input file pointer */
char **gargv; /* global argument list */
int gargc;
int c; /* global for use by warning() */
yylex() /* hoc6 */
{
while ((c=getc(fin)) == ' ' || c == '\t')
;
if (c == EOF)
return 0;
if (c == '.' || isdigit(c)) { /* number */
double d;
ungetc(c, fin);
fscanf(fin, "%lf", &d);
yylval.sym = install("", NUMBER, d);
return NUMBER;
}
if (isalpha(c)) {
Symbol *s;
char sbuf[100], *p = sbuf;
do {
if (p >= sbuf + sizeof(sbuf) - 1) {
*p = '\0';
execerror("name too long", sbuf);
}
*p++ = c;
} while ((c=getc(fin)) != EOF && isalnum(c));
ungetc(c, fin);
*p = '\0';
if ((s=lookup(sbuf)) == 0)
s = install(sbuf, UNDEF, 0.0);
yylval.sym = s;
return s->type == UNDEF ? VAR : s->type;
}
if (c == '$') { /* argument? */
int n = 0;
while (isdigit(c=getc(fin)))
n=10*n+c- '0';
ungetc(c, fin);
if (n == 0)
execerror("strange $...", (char*)0);
yylval.narg = n;
return ARG;
}
if (c == '"') { /* quoted string */
char sbuf[100], *p, *emalloc();
for (p = sbuf; (c=getc(fin)) != '"'; p++) {
if (с == '\n' || c == EOF)
execerror("missing quote", "");
if (p >= sbuf + sizeof(sbuf) - 1) {
*p = '\0';
execerror("string too long", sbuf);
}
*p = backslash(c);
}
*p = 0;
yylval.sym = (Symbol*)emalloc(strlen(sbuf)+1);
strcpy(yylval.sym, sbuf);
return STRING;
}
switch (c) {
case '>': return follow('=', GE, GT);
case '<': return follow('=', LE, LT);
case '=': return follow('=', EQ, '=');
case '!': return follow('=', NE, NOT);
case '|': return follow(' |', OR, '|');
case '&': return follow('&', AND, '&');
case '\n': lineno++; return '\n';
default: return c;
}
}
backslash(c) /* get next char with \'s interpreted */
int c;
{
char *index(); /* 'strchr()' in some systems */
static char transtab[] = "b\bf\fn\nr\rt\t";
if (c != '\\')
return c;
с = getc(fin);
if (islower(c) && index(transtab, c))
return index(transtab, с)[1];
return c;
}
follow(expect, ifyes, ifno) /* look ahead for >=, etc. */
{
int с = getc(fin);
if (c == expect)
return ifyes;
ungetc(c, fin);
return ifno;
}
defnonly(s) /* warn if illegal definition */
char *s;
{
if (!indef)
execerror(s, "used outside definition");
}
yyerror(s) /* report compile-time error */
char *s;
{
warning(s, (char *)0);
}
execerror(s, t) /* recover from run-time error */
char *s, *t;
{
warning(s, t);
fseek(fin, 0L, 2); /* flush rest of file */
longjmp(begin, 0);
}
fpecatch() /* catch floating point exceptions */
{
execerror("floating point exception", (char*)0);
}
main(argc, argv) /* hoc6 */
char *argv[];
{
int i, fpecatch();
progname = argv[0];
if (argc == 1) { /* fake an argument list */
static char *stdinonly[] = { "-" };
gargv = stdinonly;
gargc = 1;
} else {
gargv = argv+1;
gargc = argc-1;
}
init();
while (moreinput())
run();
return 0;
}
moreinput() {
if (gargc-- <= 0)
return 0;
if (fin && fin != stdin)
fclose(fin);
infile = *gargv++;
lineno = 1;
if (strcmp(infile, "-") == 0) {
fin = stdin;
infile = 0;
} else if ((fin=fopen(infile, "r")) == NULL) {
fprintf (stderr, "%s: can't open %s\n", progname, infile);
return moreinput();
}
return 1;
}
run() /* execute until EOF */
{
setjmp(begin);
signal(SIGFPE, fpecatch);
for (initcode(); yyparse(); initcode())
execute(progbase);
}
warning(s, t) /* print warning message */
char *s, *t;
{
fprintf(stderr, "%s: %s", progname, s);
if (t)
fprintf(stderr, " %s", t);
if (infile)
fprintf(stderr, " in %s", infile);
fprintf(stderr, " near line %d\n", lineno);
while (c != '\n' && c != EOF)
с = getc(fin); /* flush rest of input line */
if (c == '\n')
lineno++;
}
3.7.15
init.c
#include "hoc.h"
#include "y.tab.h"
#include
extern double Log(), Log10(), Sqrt(), Exp(), integer();
static struct { /* Keywords */
char *name;
int kval;
} keywords[] = {
"proc", PROC,
"func", FUNC,
"return", RETURN,
"if", IF,
"else", ELSE,
"while", WHILE,
"print", PRINT,
"read", READ,
0, 0,
};
static struct { /* Constants */
char *name;
double eval;
} consts[] = {
"PI", 3.14159265358979323846,
"E", 2.71828182845904523536,
"GAMMA", 0.57721566490153286060, /* Euler */
"DEG", 57.29577951308232087680, /* deg/radian */
"PHI", 1.61803398874989484820, /* golden ratio */
0, 0
};
static struct { /* Built-ins */
char *name;
double (*func)();
} builtins[] = {
"sin", sin,
"cos", cos,
"atan", atan,
"log", Log, /* checks range */
"log10", Log10, /* checks range */
"exp", Exp, /* checks range */
"sqrt", Sqrt, /* checks range */
"int", integer,
"abs", fabs,
0, 0
};
init() /* install constants and built-ins in table */
{
int i;
Symbol *s;
for (i = 0; keywords[i].name; i++)
install(keywords[i].name, keywords[i].kval, 0.0);
for (i = 0; consts[i].name; i++)
install(consts[i].name, VAR, consts[i].eval);
for (i = 0; builtins[i].name; i++) {
s = install(builtins[i].name, BLTIN, 0.0);
s->u.ptr = builtins[i].func;
}
}
3.7.16
makeapp
#!/bin/sh
cd hoc6
for i in hoc.y hoc.h symbol.c code.c init.c math.c makefile
do
echo "
**** $i ***************************************
"
sed 's/\\/\\e/g
s/^$/.sp .5/' $i |
awk '
{ print }
/(^ ;$)|(^})|(^%%)/ { print ".P3" }
'
done
3.7.17
makefile
CC = lcc
YFLAGS = -d
OBJS = hoc.o code.o init.o math.o symbol.o
hoc6: $(OBJS)
$(CC) $(CFLAGS) $(OBJS) -lm -o hoc6
hoc.o code.o init.o symbol.o: hoc.h
code.o init.o symbol.o: x.tab.h
x.tab.h: y.tab.h
-cmp -s x.tab.h y.tab.h || cp y.tab.h x.tab.h
pr: hoc.y hoc.h code.c init.c math.c symbol.c
@pr $?
@touch pr
clean:
rm -f $(OBJS) [xy].tab.[ch]
3.7.18
math.c
#include
#include
extern int errno;
double errcheck();
double Log(x)
double x;
{
return errcheck(log(x), "log");
}
double Log10(x)
double x;
{
return errcheck(log10(x), "log10");
}
double Sqrt(x)
double x;
{
return errcheck(sqrt(x), "sqrt");
}
double Exp(x)
double x;
{
return errcheck(exp(x), "exp");
}
double Pow(x, y)
double x, y;
{
return errcheck(pow(x,y), "exponentiation");
}
double integer(x)
double x;
{
return (double)(long)x;
}
double errcheck(d, s) /* check result of library call */
double d;
char *s;
{
if (errno == EDOM) {
errno = 0;
execerror(s, "argument out of domain");
} else if (errno == ERANGE) {
errno = 0;
execerror(s, "result out of range");
}
return d;
}
3.7.19
mbox
From: Polyhedron Software Ltd <100013.461@CompuServe.COM>
To: ">INTERNET:bwk@research.att.com"
Subject: Message from Internet
Date: 10 May 91 04:07:07 EDT
Message-Id: <"910510080707 100013.461 CHE27-1"@CompuServe.COM>
Got your message. I'll pass it on to Tony. We haven't noticed any
errors at all in CompuServe mail, so far.
Regards
Graham Wood
From kam Thu May 9 10:58:06 EDT 1991
tony fritzpatrick called from england. he had spoken to you
last week about compuserve.
the number is:
100013,461
this is regarding the HOC6 listing.
he will call you back tomorrow
From pipe!subll276 Fri May 3 10:38:29 EDT 1991
Message to: BK
From: Tony Fitzpatrick
ECL
Highlands Farm
Greys Road
Henley OXON, RG 94 PS
ENGLAND
Telephone: 0491 - 575-989 (country code 45)
FAX: 0491 576 557
1. H would like permission
(which has already been granted by publisher) to
use HUC 6 program — commercial software.
2. Is the listing available on floppy disk?
3. Thank you for a very interesting and useful book.
4. He left his fax # and telephone #. He wasn't sure of the country code.
He would appreciate hearing from you via fax.
sub 11276
3.7.20
symbol.c
#include "hoc.h"
#include "y.tab.h"
static Symbol *symlist =0; /* symbol table: linked list */
Symbol *lookup(s) /* find s in symbol table */
char *s;
{
Symbol *sp;
for (sp = symlist; sp != (Symbol*)0; sp = sp->next)
if (strcmp(sp->name, s) == 0)
return sp;
return 0; /* 0 ==> not found */
}
Symbol *install(s, t, d) /* install s in symbol table */
char *s;
int t;
double d;
{
Symbol *sp;
char *emalloc();
sp = (Symbol*)emalloc(sizeof(Symbol));
sp->name = emalloc(strlen(s)+1); /* +1 for '\0' */
strcpy(sp->name, s);
sp->type = t;
sp->u.val = d;
sp->next = symlist; /* put at front of list */
symlist = sp;
return sp;
}
char *emalloc(n) /* check return from malloc */
unsigned n;
{
char *p, *malloc();
p = malloc(n);
if (p == 0)
execerror("out of memory", (char*)0);
return p;
}
3.8 Всякая всячина
3.8.1
addup1
awk '{ s += $'$1' }
END { print s }'
3.8.2.
addup2
awk '
BEGIN { n = '$1' }
{ for (i = 1; i <= n; i++)
sum[i] += $i
}
END { for (i = 1; i <= n; i++) {
printf "%6g ", sum[i]
total += sum[i]
}
printf "; total = %6g\n", total
}'
3.8.3
backup
push -v panther $* /usr/bwk/eff/Code
3.8.4
backwards
# backwards: print input in backward line order
awk ' { line[NR] = $0 }
END { for (i = NR; i > 0; i--) print line[i] } ' $*
3.8.5
badpick.c
pick(s) /* offer choice of s */
char *s;
{
fprintf("%s? ", s);
if (ttyin() == 'y')
printf("%s\n", s);
}
3.8.6
bundle
# bundle: group files into distribution package
echo '# To unbundle, sh this file'
for i
do
echo "echo $i 1>&2"
echo "cat >$i <<'End of $i'"
cat $i
echo "End of $i"
done
3.8.7
cal
# cal: nicer interface to /usr/bin/cal
case $# in
0) set `date`; m=$2; y=$6 ;; # no args: use today
1) m=$1; set `date`; y=$6 ;; #1 arg: use this year
*) m=$1; y=$2 ;; #2 args: month and year
esac
case $m in
jan*|Jan*) m=1 ;;
feb*|Feb*) m=2 ;;
mar*|Mar*) m=3 ;;
apr*|Apr*) m=4 ;;
may*|May*) m=5 ;;
jun*|Jun*) m=6 ;;
jul*|Jul*) m=7 ;;
aug*|Aug*) m=8 ;;
sep*|Sep*) m=9 ;;
oct*|Oct*) m=10 ;;
nov*|Nov*) m=11 ;;
dec*|Dec*) m=12 ;;
[1-9]|10|11|12) ;; # numeric month
*) y=$m; m="" ;; # plain year
esac
/usr/bin/cal $m $y # run the real one
3.8.8
calendar1
# calendar: version 1 -- today only
awk <$HOME/calendar '
BEGIN { split("'"`date`"'", date) }
$1 == date[2] && $2 == date[3]
' | mail $NAME
3.8.9
calendar2
# calendar: version 2 -- today only, no quotes
(date; cat $HOME/calendar) |
awk '
NR == 1 { mon = $2; day = $3 } # set the date
NR > 1 && $1 == mon && $2 == day # print calendar lines
' | mail $NAME
3.8.10
calendar3
# calendar: version 3 -- today and tomorrow
awk <$HOME/calendar '
BEGIN {
x = "Jan 31 Feb 28 Mar 31 Apr 30 May 31 Jun 30 " \
"Jul 31 Aug 31 Sep 30 Oct 31 Nov 30 Dec 31 Jan 31"
split(x, data)
for (i = 1; i < 24; i += 2) {
days[data[i]] = data[i+1]
nextmon[data[i]] = data[i+2]
}
split("'"`date`"'", date)
mon1 = date[2]; day1 = date[3]
mon2 = mon1; day2 = day1 + 1
if (day1 >= days[mon1]) {
day2 = 1
mon2 = nextmon[mon1]
}
}
$1 == mon1 && $2 == day1 || $1 == mon2 && $2 == day2
' | mail $NAME
3.8.11
cat0.c
/* cat: minimal version */
#define SIZE 512 /* arbitrary */
main() {
char buf[SIZE];
int n;
while ((n = read(0, buf, sizeof buf)) > 0)
write(1, buf, n);
exit(0);
}
3.8.12
checkmail.c
/* checkmail: watch user's mailbox */
#include
#include
#include
char *progname;
char *maildir = "/usr/spool/mail"; /* system dependent */
main(argc, argv)
int argc;
char *argv[];
{
struct stat buf;
char *name, *getlogin();
int lastsize = 0;
progname = argv[0];
if ((name = getlogin()) == NULL)
error("can't get login name", (char*)0);
if (chdir(maildir) == -1)
error("can't cd to %s", maildir);
for (;;) {
if (stat(name, &buf) == -1) /* no mailbox */
buf.st_size = 0;
if (buf.st_size > lastsize)
fprintf(stderr, "\nYou have mail\007\n");
lastsize = buf.st_size;
sleep(60);
}
}
#include "error.c"
3.8.13
checkmail.sh
# checkmail: watch mailbox for growth
PATH=/bin:/usr/bin
MAIL=/usr/spool/mail/`getname` # system dependent
t=${1-60}
x="`ls -l $MAIL`"
while :
do
y="`ls -l $MAIL`"
echo $x $y x="$y"
sleep $t
done | awk '$4 < $12 { print "You have mail" }'
3.8.14
cp.c
/* cp: minimal version */
#include
#define PERMS 0644 /* RW for owner, R for group, others */
char *progname;
main(argc, argv) /* cp: copy f1 to f2 */
int argc;
char *argv[];
{
char buf[BUFSIZ];
progname = argv[0];
if (argc != 3)
error("Usage: %s from to", progname);
if ((f1 = open(argv[1], 0)) == -1)
error("can't open %s", argv[1]);
if ((f2 = creat(argv[2] , PERMS)) == -1)
error("can't create %s", argv[2]);
while ((n = read(f1, buf, BUFSIZ)) > 0)
if (write(f2, buf, n) != n)
error("write error", (char*)0);
exit(0);
}
#include "error.c"
3.8.15
doctype
# doctype: synthesize proper command line for troff
echo -n "cat $* | "
egrep -h '^\.(EQ|TS|\[|PS|IS|PP)' $* |
sort -u | awk '
/^\.PP/ { ms++ }
/^\.EQ/ { eqn++ }
/^\.TS/ { tbl++ }
/^\.PS/ { pic++ }
/^\.IS/ { ideal++ }
/^\.\[/ { refer++ }
END {
if (refer > 0) printf "refer | "
if (pic > 0) printf "pic | "
if (ideal > 0) printf "ideal | "
if (tbl > 0) printf "tbl | "
if (eqn > 0) printf "eqn | "
printf "troff "
if (ms > 0) printf "-ms"
printf "\n"
}'
3.8.16
double
awk '
FILENAME != prevfile { # new file
NR = 1 # reset line number
prevfile = FILENAME
}
NF > 0 {
if ($1 == lastword)
printf "double %s, file %s, line %d\n" ,$1,FILENAME,NR
for (i = 2; i <= NF; i++)
if ($i == $(i-1))
printf "double %s, file %s, line %d\n" ,$i, FILENAME ,NR
if (NF > 0)
lastword = $NF
}' $*
3.8.17
efopen.c
FILE *efopen(file, mode) /* fopen file, die if can't */
char *file, *mode;
{
FILE *fp, *fopen();
extern char *progname;
if ((fp = fopen(file, mode)) != NULL)
return fp;
fprintf (stderr, "%s: can't open file %s mode %s\n",
progname, file, mode);
exit(1);
}
3.8.18
error.c
error(s1, s2) /* print error message and die */
char *s1, *s2;
{
extern int errno, sys_nerr;
extern char *sys_errlist[], *progname;
if (progname)
fprintf(stderr, "%s: ", progname);
fprintf(stderr, s1, s2);
if (errno > 0 && errno < sys_nerr)
fprintf (stderr, " (%s)", sys_errlist[errno]);
fprintf(stderr, "\n");
exit(1);
}
3.8.19
field1
awk '{ print $'$1' }'
3.8.20
field2
awk "{ print \$$1 }"
3.8.21
fold
# fold: fold long lines
sed 's/\(->/ /g' $* | # convert tabs to spaces
awk '
BEGIN {
N = 80 # folds at column 80
for (i = 1; i <= N; i++) # make a string of blanks
blanks = blanks " "
}
{ if ((n = length($0)) <= N)
else {
for (i = 1; n > N; n -= N) {
printf "%s\\\n", substr($0, i ,N)
i += N;
}
printf "%s%s\n", substr(blanks, 1, N-n), substr($0, i)
}
} '
3.8.22
frequent
cat $* |
tr -sc A-Za-z '\012' |
sort |
uniq -с |
sort -n |
tail |
5
3.8.23
frequent2
sed 's/[ \(->][ \(->]*/\
/g' $* | sort | uniq -с | sort -nr | sed 10q
3.8.24
get
# get: extract file from history
PATH=/bin:/usr/bin
VERSION=0
while test "$1" != ""
do
case "$1" in
-i) INPUT=$2; shift ;;
-o) OUTPUT=$2; shift ;;
-[0-9]) VERSION=$1 ;;
-*) echo "get: Unknown argument $i" 1>&2; exit 1 ;;
*) case "$OUTPUT" in
"") OUTPUT=$1 ;;
*) INPUT=$1.H ;;
esac
esac
shift
done
OUTPUT=${OUTPUT?"Usage: get [-o outfile] [-i file.H] file"}
INPUT=${INPUT-$OUTPUT.H}
test -r $INPUT || { echo "get: no file $INPUT" 1>&2; exit 1; }
trap 'rm -f /tmp/get.[ab]$$; exit 1' 1 2 15
# split into current version and editing commands
sed <$INPUT -n '1,/^@@@/w /tmp/get.a'$$'
/^@@@/,$w /tmp/get.b'$$
# perform the edits
awk
/^@@@/ { count++ }
!/^@@@/ && count > 0 && count <= - '$VERSION'
END { print "$d"; print "w", "'$OUTPUT'" }
' | ed - /tmp/get.a$$
rm -f /tmp/get.[ab]$$
3.8.25
get.с
get(fd, pos, buf, n) /* read n bytes from position pos */
int fd, n;
long pos;
char *buf;
{
if (lseek(fd, pos, 0) == -1) /* get to pos */
return -1;
return read(fd, buf, n);
}
3.8.26
getname
who am i | sed 's/ .*//'
3.8.27
idiff.c
/* idiff: interactive diff */
#include
#include
char *progname;
#define HUGE 10000 /* large number of lines */
main(argc, argv)
int argc;
char *argv[];
{
FILE *fin, *fout, *f1, *f2, *efopen();
char buf[BUFSIZ], *mktemp();
char *diffout = "idiff.XXXXXX";
progname = argv[0];
if (argc != 3) {
fprintf(stderr, "Usage: idiff file1 file2\n");
exit(1);
}
f1 = efopen(argv[1], "r");
f2 = efopen(argv[2], "r");
fout = efopen("idiff.out", "w");
mktemp(diffout);
sprintf(buf, "diff %s %s >%s", argv[1], argv[2], diffout);
system(buf);
fin = efopen(diffout, "r");
idiff(f1, f2, fin, fout); unlink(diffout);
printf("%s output in file idiff.out\n", progname);
exit(0);
}
idiff(f1, f2, fin, fout) /* process diffs */
FILE *f1, *f2, *fin, *fout;
{
char *tempfile = "idiff.XXXXXX";
char buf[BUFSIZ], buf2[BUFSIZ], *mktemp();
FILE *ft, *efopen();
int cmd, n, from1, to1, from2, to2, nf1, nf2;
mktemp(tempfile);
nf1 = nf2 = 0;
while (fgets(buf, sizeof buf, fin) != NULL) {
parse(buf, &from1, &to1, &cmd, &from2, &to2);
n = to1-from1 + to2-from2 + 1; /* #lines from diff */
if (cmd == 'c')
n += 2;
else if (cmd == 'a')
from1++;
else if (cmd == 'd')
from2++;
printf("%s", buf);
while (n-- > 0) {
fgets(buf, sizeof buf, fin);
printf("%s", buf);
}
do {
printf("? ");
fflush(stdout);
fgets(buf, sizeof buf, stdin);
switch (buf[0]) {
case '>':
nskip(f1, to1-nf1);
ncopy(f2, to2-nf2, fout);
break;
case '<':
nskip(f2, to2-nf2);
ncopy(f1, to1-nf1, fout);
break;
case 'e':
ncopy(f1, from1-1-nf1, fout);
nskip(f2, from2-1-nf2);
ft = efopen(tempfile, "w");
ncopy(f1, to1+1-from1, ft);
fprintf(ft, "--- \n");
ncopy(f2, to2+1-from2, ft);
fclose(ft);
sprintf(buf2, "ed %s", tempfile);
system(buf2);
ft = efopen(tempfile, "r");
ncopy(ft, HUGE, fout);
fclose(ft);
break;
case '!':
system(buf+1);
printf("!\n");
break;
default:
printf("< or > or e or !\n");
break;
}
} while (buf[0]!= '<' && buf[0]!= '>' && buf[0]! = 'e');
nf1 = to1;
nf2 = to2;
}
ncopy(f1, HUGE, fout); /* can fail on very long files */
unlink(tempfile);
}
parse(s, pfrom1, pto1, pcmd, pfrom2, pto2)
char *s;
int *pcmd, *pfrom1, *pto1, *pfrom2, *pto2;
{
#define a2i(p) while (isdigit(*s)) \
p = 10*(p) + *s++ - '0'
*pfrom1 = *pto1 = *pfrom2 = *pto2 = 0;
a2i(*pfrom1);
if (*s == ',') {
s++;
a2i(*pto1);
} else
*pto1 = *pfrom1;
*pcmd = *s++;
a2i(*pfrom2);
if (*s == ',') {
s++;
a2i(*pto2);
} else
*pto2 = *pfrom2;
}
nskip(fin, n) /* skip n lines of file fin */
FILE *fin;
{
char buf[BUFSIZ];
while (n-- > 0)
fgets(buf, sizeof buf, fin);
}
ncopy(fin, n, fout) /* copy n lines from fin to fout */
FILE *fin, *fout;
{
char buf[BUFSIZ];
while (n-- > 0) {
if (fgets(buf, sizeof buf, fin) == NULL)
return;
fputs(buf, fout);
}
}
#include "efopen.c"
3.8.28
makefile
files: files.o files1.o directory.o
cc files.o files1.o directory.o -o files
p0: p0.c ttyin0.c
cc p0.c ttyin0.c
clean:
rm -f *.o a.out
3.8.29
newer
# newer f: list files newer than f
ls -t | sed '/^'$1'$/q'
3.8.30
news1
# news: print news files, version 1
HOME=. # debugging only
cd . # place holder for /usr/news
for i in `ls -t * $HOME/.news_time`
do
case $i in
*/.news_time) break ;;
*) echo news: $i
esac
done
touch $HOME/.news_time
3.8.31
news2
# news: print news files, version 2
HOME=. # debugging only
cd . # place holder for /usr/news
IFS='
' # just a newline
for i in `ls -t * $HOME/.news_time 2>&1`
do
case $i in
*' not found') ;;
*/.news_time) break ;;
*) echo news: $i ;;
esac
done
touch $HOME/.news_time
3.8.32
news3
# news: print news files, final version
PATH=/bin:/usr/bin
IFS='
' # just a newline
cd /usr/news
for i in `ls -t * $HOME/.news_time 2>&1`
do
IFS=' '
case $i in
*' not found') ;;
*/.news_time) break ;;
*) set X`ls -l $i`
echo "
$i: ($3) $5 $6 $7
"
cat $i
esac
done
touch $HOME/.news_time
3.8.33
nohup
trap "" 1 15
if test -t 2>&1
then
echo "Sending output to 'nohup.out'"
exec nice -5 $* >>nohup.out 2>&1
else
exec nice -5 $* 2>&1
fi
3.8.34
older
# older f: list files older than f
ls -tr | sed '/^'$!'$/q'
3.8.35
overwrite1
# overwrite: copy standard input to output after EOF
# version 1. BUG here
PATH=/bin:/usr/bin
case $# in
1) ;;
*) echo 'Usage: overwrite file' 1>&2; exit 2
esac
new=/tmp/overwr.$$
trap 'rm -f $new; exit 1' 1 2 15
cat >$new # collect the input
cp $new $1 # overwrite the input file
rm -f $new
3.8.36
overwrite2
# overwrite: copy standard input to output after EOF
# version 2. BUG here too
PATH=/bin:/usr/bin
case $# in
1) ;;
*) echo 'Usage: overwrite file' 1>&2; exit 2
esac
new=/tmp/overwr1.$$
old=/tmp/overwr2.$$
trap 'rm -f $new $old; exit 1' 1 2 15
cat >$new # collect the input
cp $1 $old # save original file
trap '' 1 2 15 # we are committed; ignore signals
cp $new $1 # overwrite the input file
rm -f $new $old
3.8.37
overwrite3
# overwrite: copy standard input to output after EOF
# final version
opath=$PATH
PATH=/bin:/usr/bin
case $# in
0|1) echo 'Usage: overwrite file cmd [args]' 1>&2; exit 2
esac
file=$1; shift
new=/tmp/overwr1.$$; old=/tmp/overwr2.$$
trap 'rm -f $new $old; exit 1' 1 2 15 # clean up files
if PATH=$opath >$new # collect input
then
cp $file $old # save original file
trap '' 1 2 15 # we are committed; ignore signals
cp $new $file
else
echo "overwrite: $1 failed, $file unchanged" 1>&2
exit 1
fi
rm -f $new $old
3.8.38
p1.c
/* p: print input in chunks (version 1) */
#include
#define PAGESIZE 22
char *progname; /* program name for error message */
main(argc, argv)
int argc;
char *argv[];
{
int i;
FILE *fp, *efopen();
progname = argv[0];
if (argc == 1)
print(stdin, PAGESIZE);
else
for (i = 1; i < argc; i++) {
fp = efopen(argv[i], "r");
print(fp, PAGESIZE);
fclose(fp);
}
exit(0);
}
print(fp, pagesize) /* print fp in pagesize chunks */
FILE *fp;
int pagesize;
{
static int lines = 0; /* number of lines so far */
char buf[BUFSIZ];
while (fgets(buf, sizeof buf, fp) != NULL)
if (++lines < pagesize)
fputs(buf, stdout);
else {
buf[strlen(buf)-1] = '\0';
fputs(buf, stdout);
fflush(stdout);
ttyin();
lines = 0;
}
}
#include "ttyin1.c"
#include "efopen.c"
3.8.39
p2.c
/* p: print input in chunks (version 2) */
#include
#define PAGESIZE 22
char *progname; /* program name for error message */
main(argc, argv)
int argc;
char *argv[];
{
FILE *fp, *efopen();
int i, pagesize = PAGESIZE;
progname = argv[0];
if (argc > 1 && argv[1][0] == '-') {
pagesize = atoi(&argv[1][1]);
argc--;
argv++;
}
if (argc == 1)
print(stdin, pagesize);
for (i = 1; i < argc; i++) {
fp = efopen(argv[i], "r");
print(fp, pagesize);
fclose(fp);
}
exit(0);
}
print(fp, pagesize) /* print fp in pagesize chunks */
FILE *fp;
int pagesize;
{
static int lines = 0; /* number of lines so far */
char buf[BUFSIZ];
while (fgets(buf, sizeof buf, fp) != NULL)
if (++lines < pagesize)
fputs(buf, stdout);
else {
buf[strlen(buf)-1] = '\0';
fputs(buf, stdout);
fflush(stdout);
ttyin();
lines = 0;
}
}
#include "ttyin2.c"
#include "efopen.c"
3.8.40
p3.c
/* p: print input in chunks (version 3) */
#include
#define PAGESIZE 22
char *progname; /* program name for error message */
main(argc, argv)
int argc;
char *argv[];
{
FILE *fp, *efopen();
int i, pagesize = PAGESIZE;
char *p, *getenv();
progname = argv[0];
if ((p=getenv("PAGESIZE")) != NULL)
pagesize = atoi(p);
if (argc > 1 && argv[1][0] == '-') {
pagesize = atoi(&argv[1][1]);
argc--;
argv++;
}
if (argc == 1)
print(stdin, pagesize);
else
for (i = 1; i < argc; i++) {
fp = efopen(argv[i], "r");
print(fp, pagesize);
fclose(fp);
}
exit(0);
}
print(fp, pagesize) /* print fp in pagesize chunks */
FILE *fp;
int pagesize;
{
static int lines = 0; /* number of lines so far */
char buf[BUFSIZ];
while (fgets(buf, sizeof buf, fp) != NULL)
if (++lines < pagesize)
fputs(buf, stdout);
else {
buf[strlen(buf)-1] = '\0';
fputs(buf, stdout);
fflush(stdout);
ttyin();
lines = 0;
}
}
#include "ttyin2.c"
#include "efopen.c"
3.8.41
p4.c
/* p: print input in chunks (version 4) */
#include
#define PAGESIZE 22
char *progname; /* program name for error message */
main(argc, argv)
int argc;
char *argv[];
{
FILE *fp, *efopen();
int i, pagesize = PAGESIZE;
char *p, *getenv(), buf[BUFSIZ];
progname = argv[0];
if ((p=getenv("PAGESIZE")) != NULL)
pagesize = atoi(p);
if (argc > 1 && argv[1][0] == '-') {
pagesize = atoi(&argv[1][1]);
argc--;
argv++;
}
if (argc == 1)
print(stdin, pagesize);
else
for (i = 1; i < argc; i++)
switch (spname(argv[i], buf)) {
case -1: /* no match possible */
fp = efopen(argv[i], "r");
break;
case 1: /* corrected */
fprintf (stderr, "\"%s\"? ", buf);
if (ttyin() == 'n')
break;
argv[i] = buf;
/* fall through... */
case 0: /* exact match */
fp = efopen(argv[i], "r");
print(fp, pagesize);
fclose(fp);
}
exit(0);
}
print(fp, pagesize) /* print fp in pagesize chunks */
FILE *fp;
int pagesize;
{
static int lines = 0; /* number of lines so far */
char buf[BUFSIZ];
while (fgets(buf, sizeof buf, fp) != NULL)
if (++lines < pagesize) fputs(buf, stdout);
else {
buf[strlen(buf)-1] = '\0';
fputs(buf, stdout);
fflush(stdout);
ttyin();
lines = 0;
}
}
#include "ttyin2.c"
#include "efopen.c"
#include "spname.c"
3.8.42
pick1
# pick: select arguments
PATH=/bin:/usr/bin
for i # for each argument
do
echo -n "$i? " >/dev/tty
read response
case $response in
y*) echo $i ;;
q*) break
esac
done
3.8.43
pick.c
/* pick: offer choice on each argument */
#include
char *progname; /* program name for error message */
main(argc, argv)
int argc;
char *argv[];
{
int i;
char buf[BUFSIZ];
progname = argv[0];
if (argc == 2 && strcmp(argv[1], "-") == 0) /* pick - */
while (fgets(buf, sizeof buf, stdin) != NULL) {
buf[strlen(buf)-1] = '\0'; /* drop newline */
pick(buf);
}
for (i = 1; i < argc; i++)
pick(argv[i]);
exit(0);
}
pick(s) /* offer choice of s */
char *s;
{
fprintf(stderr, "%s? ", s);
if (ttyin() == 'y')
printf("%s\n", s);
}
#include "ttyin2.c"
#include "efopen.c"
3.8.44
prpages
# prpages: compute number of pages that pr will print
wc $* |
awk '!/ total$/ { n += int(($1+55) / 56) }
END { print n }'
3.8.45
put
# put: install file into history
PATH=/bin:/usr/bin
case $# in
1) HIST=$1.H ;;
*) echo 'Usage: put file' 1>&2; exit 1 ;;
esac
if test ! -r $1
then
echo "put: can't open $1" 1>&2
exit 1
fi
trap 'rm -f /tmp/put.[ab]$$; exit 1 12 15
echo -n 'Summary: '
read Summary
if get -o /tmp/put.a$$ $1 # previous version
then # merge pieces
cp $1 /tmp/put.b$$ # current version
echo `getname` `date` $Summary" >>/tmp/put.b$$
diff -e $1 /tmp/put.a$$ >>/tmp/put.b$$ # latest diffs
sed -n '/^@@@/,$р' <$HIST >>/tmp/put.b$$ # old diffs
overwrite $HIST cat /tmp/put.b$$ # put it back
else # make a new one
echo "put: creating $HIST"
cp $1 $HIST
echo "@@@ `getname` `date` $Summary" >>$HIST
fi
rm -f /tmp/put.[ab]$$
3.8.46
readslow.c
/* readslow: keep reading, waiting for more */
#define SIZE 512 /* arbitrary */
main() {
char buf[SIZE];
int n;
for (;;) {
while ((n = read(0, buf, sizeof buf)) > 0)
write(1, buf, n);
sleep(10);
}
}
3.8.47
replace
# replace: replace str1 in files with str2, in place
PATH=/bin:/usr/bin
case $# in
0|1|2) echo 'Usage: replace str1 str2 files' 1>&2; exit 1
esac
left="$1"; right="$2"; shift; shift
for i
do
overwrite $i sed "s@$left@$right@g" $i
done
3.8.48
signaltest.c
#include
#include
#include
extern int errno;
main() {
int с, n;
char buf[100];
int onintr();
signal(SIGINT, onintr);
for (;;) {
n = read(0, buf, 100);
if (n > 0)
printf(buf);
else {
if (errno == EINTR) {
errno = 0;
printf("interrupt side %d\n", n);
} else {
printf("true end of file %d\n", n);
}
}
}
}
onintr() {
signal(SIGINT, onintr);
printf("interrupt\n");
}
3.8.49
spname.c
/* spname: return correctly spelled filename */
/*
* spname(oldname, newname) char *oldname, *newname;
* returns -1 if no reasonable match to oldname,
* 0 if exact match,
* 1 if corrected.
* stores corrected name in newname.
*/
#include
#include
spname(oldname, newname)
char *oldname, *newname;
{
char *p, guess[DIRSIZ+1], best[DIRSIZ+1];
char *new = newname, *old = oldname;
for (;;) {
while (*old == '/') /* skip slashes */
*new++ = *old++;
*new = '\0';
if (*old == '\0') /* exact or corrected */
return strcmp(oldname, newname) != 0;
p = guess; /* copy next component into guess */
for ( ; *old != '/' && *old != '\0'; old++)
if (p < guess+DIRSIZ)
*p++ = *old;
*p = '\0';
if (mindist(newname, guess, best) >= 3)
return -1; /* hopeless */
for (p = best; *new = *p++; ) /* add to end */
new++; /* of newname */
}
}
mindist(dir, guess, best) /* search dir for guess */
char *dir, *guess, *best;
{
/* set best, return distance 0..3 */
int d, nd, fd;
struct {
ino_t ino;
char name[DIRSIZ+1]; /* 1 more than in dir.h */
} nbuf;
nbuf.name[DIRSIZ] = '\0'; /* +1 for terminal '\0' */
if (dir[0] == '\0') /* current directory */
dir = ".";
d = 3; /* minimum distance */
if ((fd=open(dir, 0)) == -1)
return d;
while (read(fd, (char*)&nbuf, sizeof(struct direct)) > 0)
if (nbuf.ino) {
nd = spdist(nbuf.name, guess);
if (nd <= d && nd != 3) {
strcpy(best, nbuf.name);
d = nd;
if (d == 0) /* exact match */
break;
}
}
close(fd);
return d;
}
/* spdist: return distance between two names */
/*
* very rough spelling metric:
* 0 if the strings are identical
* 1 if two chars are transposed
* 2 if one char wrong, added or deleted
* 3 otherwise
*/
#define EQ(s,t) (strcmp(s,t) == 0)
spdist(s, t)
char *s, *t;
{
while (*s++ == *t)
if (*t++ == '\0')
return 0; /* exact match */
if (*--s) {
if (*t) {
if (s[1] && t[1] && *s == t[1] && *t == s[1] && EQ(s+2, t+2))
return 1; /* transposition */
if (EQ(s+1, t+1))
return 2; /* 1 char mismatch */
}
if (EQ(s+1, t))
return 2; /* extra character */
}
if (*t && EQ(s, t+1))
return 2; /* missing character */
return 3;
}
3.8.50
strindex.c
strindex(s, t) /* return index of t in s, -1 if none */
char *s, *t;
{
int i, n;
n = strlen(t);
for (i = 0; s[i] != '\0'; i++)
if (strncmp(s+i, t, n) == 0)
return i;
return -1;
}
3.8.51
sv.c
/* sv: save new files */
#include
#include
#include
#include
char *progname;
main(argc, argv)
int argc;
char *argv[];
{
int i;
struct stat stbuf;
char *dir = argv[argc-1];
progname = argv[0];
if (argc <= 2)
error ("Usage: %s files... dir", progname);
if (stat(dir, festbuf) == -1)
error("can't access directory %s", dir);
if ((stbuf.st_mode & S_IFMT) != S_IFDIR)
error("%s is not a directory", dir);
for (i = 1; i < argc-1; i++)
sv(argv[i], dir);
exit(0);
}
sv(file, dir) /* save file in dir */
char *file, *dir;
{
struct stat sti, sto;
int fin, fout, n;
char target[BUFSIZ], buf[BUFSIZ], *index();
sprintf(target, "%s/%s", dir, file);
if (index(file, '/') != NULL) /* strchr() in some systems */
error("won't handle '/'s in %s", file);
if (stat(file, &sti) == -1)
error("can't stat %s", file);
if (stat(target, &sto) == -1) /* target not present */
sto.st_mtime = 0; /* so make it look old */
if (sti.st_mtime < sto.st_mtime) /* target is newer */
fprintf(stderr, "%s: %s not copied\n", progname, file);
else if ((fin = open(file, 0)) == -1)
error("can't open file %s", file);
else if ((fout = creat(target, sti.st_mode)) == -1)
error("can't create %s", target);
while ((n = read(fin, buf, sizeof buf)) > 0)
if (write(fout, buf, n) != n)
error("error writing %s", target);
close(fin);
close(fout);
}
#include "error.c"
3.8.52
system1.c
#include
system(s) /* run command line s */
char *s;
{
int status, pid, w, tty;
int (*istat)(), (*qstat)();
...
if ((pid = fork()) == 0) {
...
execlp("sh", "sh", "-c", s, (char*)0);
exit(127);
}
...
istat = signal(SIGINT, SIG_IGN);
qstat = signal(SIGQUIT, SIG_IGN);
while ((w = wait(&status)) != pid && w != -1)
;
if (w == -1)
status = -1;
signal(SIGINT, istat);
signal(SIGQUIT, qstat);
return status;
}
3.8.53
system.c
/*
* Safer version of system for interactive programs
*/
#include
#include
system(s) /* run command line s */
char *s;
{
int status, pid, w, tty;
int (*istat)(), (*qstat)();
extern char *progname;
fflush(stdout);
tty = open("/dev/tty", 2);
if (tty == -1) {
fprintf (stderr, "%s: can't open /dev/tty\n", progname);
return -1;
}
if ((pid = fork()) == 0) {
close(0);
dup(tty);
close(1);
dup(tty);
close(2);
dup(tty);
close(tty);
execlp("sh", "sh", "-c", s, (char*)0);
exit(127);
}
close(tty);
istat = signal(SIGINT, SIG_IGN);
qstat = signal(SIGQUIT, SIG_IGN);
while ((w = wait(&status)) != pid && w != -1)
;
if (w == -1)
status = -1;
signal(SIGINT, istat);
signal(SIGQUIT, qstat);
return status;
}
3.8.54
timeout.c
/* timeout: set time limit on a process */
#include
#include
int pid; /* child process id */
char *progname;
main(argc, argv)
int argc;
char *argv[];
{
int sec = 10, status, onalarm();
progname = argv[0];
if (argc > 1 && argv[1][0] == '-') {
sec = atoi(&argv[1][1]);
argc--;
argv++;
}
if (argc < 2)
error("Usage: %s [-10] command", progname);
if ((pid=fork()) == 0) {
execvp(argv[1], &argv[1]);
error("couldn't start %s", argv[1]);
}
signal(SIGALRM, onalarm);
alarm(sec);
if (wait(&status) == -1 || (status & 0177) != 0)
error("%s killed", argv[1]);
exit((status >> 8) & 0377);
}
onalarm() /* kill child when alarm arrives */
{
kill(pid, SIGKILL);
}
#include "error.c"
3.8.55
toolong
length($0) > 72 { print "Line", NR, "too long:", substr($0,1,60) }
3.8.56
ttyin1.c
ttyin() /* process response from /dev/tty (version 1) */
{
char buf[BUFSIZ];
FILE *efopen();
static FILE *tty = NULL;
if (tty == NULL)
tty = efopen("/dev/tty", "r");
if (fgets(buf, BUFSIZ, tty) == NULL || buf[0] == 'q')
exit(0);
else /* ordinary line */
return buf[0];
}
3.8.57
ttyin2.c
ttyin() /* process response from /dev/tty (version 2) */
{
char buf[BUFSIZ];
FILE *efopen();
static FILE *tty = NULL;
if (tty == NULL)
tty = efopen("/dev/tty", "r");
for (;;) {
if (fgets(buf,BUFSIZ,tty) == NULL || buf[0] == 'q')
exit(0);
else if (buf[0] == '!') {
system(buf+1); /* BUG here */
printf("!\n");
}
else /* ordinary line */
return buf[0];
}
}
#include "system.c"
3.5.58
vis1.c
/* vis: make funny characters visible (version 1) */
#include
#include
main() {
int c;
while ((c = getchar()) != EOF)
if (isascii(c) &&
(isprint(c) || c=='\n' || c=='\t' || c==' '))
putchar(c);
else
printf("\\%03o", c);
exit(0);
}
3.5.59
vis2.c
/* vis: make funny characters visible (version 2) */
#include
#include
main(argc, argv)
int argc;
char *argv[];
{
int с, strip = 0;
if (argc > 1 && strcmp(argv[1] , "-s") == 0)
strip = 1;
while ((c = getchar()) != EOF) if (isascii(c) &&
(isprint(c) || c=='\n' || c=='\t' || c==' '))
putchar(c);
else if (!strip)
printf("\\%03o", c);
exit(0);
}
3.8.60
vis3.c
/* vis: make funny characters visible (version 3) */
#include
#include
int strip = 0; /* 1 => discard special characters */
main(argc, argv)
int argc;
char *argv[];
{
int i;
FILE *fp;
while (argc > 1 && argv[1][0] == '-') {
switch (argv[1][1]) {
case 's': /* -s: strip funny chars */
strip = 1;
break;
default:
fprintf(stderr, "%s: unknown arg %s\n",
argv[0], argv[1]);
exit(1);
}
argc--;
argv++;
}
if (argc == 1)
vis(stdin);
for (i = 1; i < argc; i++)
if ((fp=fopen(argv[i], "r")) == NULL) {
fprintf(stderr, "%s: can't open %s\n",
argv[0], argv[i]);
exit(1);
} else {
vis(fp);
fclose(fp);
}
exit(0);
}
vis(fp) /* make chars visible in FILE *fp */
FILE *fp;
{
int c;
while ((c = getc(fp)) != EOF)
if (isascii(c) &&
(isprint(c) || c=='\n' || c=='\t' || c==' '))
putchar(c);
else if (!strip)
printf("\\%03o", с);
}
3.8.61
waitfile.c
/* waitfile: wait until file stops changing */
#include
#include
#include
char *progname;
main(argc, argv)
int argc;
char *argv[];
{
int fd;
struct stat stbuf;
time_t old_time = 0;
progname = argv[0];
if (argc < 2)
error("Usage: %s filename [cmd]", progname);
if ((fd = open(argv[1], 0)) == -1)
error("can't open %s", argv[1]);
fstat(fd, &stbuf);
while (stbuf.st_mtime != old_time) {
old_time = stbuf.st_mtime;
sleep(60);
fstat(fd, &stbuf);
}
if (argc == 2) { /* copy file */
execlp("cat", "cat", argv[1], (char*)0);
error("can't execute cat %s", argv[1]);
} else { /* run process */
execvp(argv[2], &argv[2]);
error("can't execute %s", argv[2]);
}
exit(0);
}
#include "error.c"
3.8.62
watchfor
# watchfor: watch for someone to log in
PATH=/bin:/usr/bin
case $# in
0) echo 'Usage: watchfor person' 1>&2; exit 1
esac
until who | egrep "$1"
do
sleep 60
done
3.8.63
watchwho
# watchwho: watch who logs in and out
PATH=/bin:/usr/bin
new=/tmp/wwho1.$$
old=/tmp/wwho2.$$
> $old # create an empty file
while : # loop forever
do
who >$new
diff $old $new
mv $new $old
sleep 60
done | awk '/>/ { $1 = "in: "; print }
/
3.8.64
which1
# which cmd: which cmd in PATH is executed, version 1
case $# in
0) echo 'Usage: which command' 1>&2; exit 2
esac
for i in `echo $PATH | sed 's/^:/.:/
s/::/:.:/g
s/:$/:./
s/:/ /g'`
do
if test -f $i/$1 # use test -x if you can
then
echo $i/$1
exit 0 # found it
fi
done
exit 1 # not found
3.8.65
which1.H
# which cmd: which cmd in PATH is executed, version 1
case $# in
0) echo 'Usage: which command' 1>&2; exit 2
esac
for i in `echo $PATH | sed 's/^:/.:/
s/::/:.:/g
s/:$/:./
s/:/ /g'`
do
if test -f $i/$1 # use test -x if you can
then
echo $i/$1
exit 0 # found it
fi
done
exit 1 # not found
@@@ Fri Oct 14 14:21:11 EDT 1983 original version
3.8.66
which2
# which cmd: which cmd in PATH is executed, final version
opath=$PATH PATH=/bin:/usr/bin
case $# in
0) echo 'Usage: which command' 1>&2; exit 2
esac
for i in `echo $opath | sed 's/^:/.:/
s/::/:.:/g
s/:$/:./
s/:/ /g'`
do
if test -f $i/$1 # this is /bin/test
then # or /usr/bin/test only
echo $i/$1
exit 0 # found it
fi
done
exit 1 # not found
3.8.67
wordfreq
awk ' { for (i = 1; i <= NF; i++) num[$i]++ }
END {for (word in num) print word, num[word] }
' $*
3.8.68
zap1
# zap pattern: kill all processes matching pattern
# BUG in this version
PATH=/bin:/usr/bin
case $# in
0) echo 'Usage: zap pattern' 1>&2; exit 1
esac
kill `pick \`ps -ag | grep "$*"\` | awk '{print $1}'`
3.8.69
zap2
# zap pat: kill all processes matching pat
# final version
PATH=/bin:/usr/bin
IFS='
' # just a newline
case $1 in
"") echo 'Usage: zap [-2] pattern' 1>&2; exit 1 ;;
-*) SIG=$1; shift
esac
echo ' PID TTY TIME CMD'
kill $SIG `pick \`ps -ag | egrep "$*"|` | awk '{print $1}'`
3.8.70
zap.c
/* zap: interactive process killer */
#include
#include
char *progname; /* program name for error message */
char *ps = "ps -ag"; /* system dependent */
main(argc, argv)
int argc;
char *argv[];
{
FILE *fin, *popen();
char buf[BUFSIZ];
int pid;
progname = argv[0];
if ((fin = popen(ps, "r")) == NULL) {
fprintf (stderr, "%s: can't run %s\n", progname, ps);
exit(1);
}
fgets(buf, sizeof buf, fin); /* get header line */
fprintf (stderr, "%s", buf);
while (fgets(buf, sizeof buf, fin) != NULL)
if (argc == 1 || strindex(buf, argv[1]) >= 0) {
buf[strlen(buf)-1] = '\0'; /* suppress \n */
fprintf (stderr, "%s? ", buf);
if (ttyin() == 'y') {
sscanf(buf, "%d", &pid);
kill(pid, SIGKILL);
}
}
exit(0);
}
#include "ttyin2.c"
#include "strindex.c"
#include "efopen.c"