UNIX — универсальная среда программирования

Керниган Брайан Уилсон

Пайк Роб

Приложение 3

Исходные тексты калькулятора hoc

 

 

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 NUMBER

%token VAR

%type expr

%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 NUMBER

%token VAR BLTIN UNDEF

%type expr asgn

%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 NUMBER

%token VAR BLTIN UNDEF

%type expr asgn

%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 NUMBER VAR BLTIN UNDEF

%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 NUMBER PRINT VAR BLTIN UNDEF WHILE IF ELSE

%type stmt asgn expr stmtlist cond while if end

%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 NUMBER STRING PRINT VAR BLTIN UNDEF WHILE IF ELSE

%token FUNCTION PROCEDURE RETURN FUNC PROC READ

%token ARG

%type expr stmt asgn prlist stmtlist

%type cond while if begin end

%type procname

%type arglist

%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 <[email protected]>

To: ">INTERNET:[email protected]

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)

  print

  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"