BSD 4_3 development
authorCSRG <csrg@ucbvax.Berkeley.EDU>
Mon, 26 Aug 1985 19:19:20 +0000 (11:19 -0800)
committerCSRG <csrg@ucbvax.Berkeley.EDU>
Mon, 26 Aug 1985 19:19:20 +0000 (11:19 -0800)
Work on file usr/contrib/B/src/bed/b.h
Work on file usr/contrib/B/src/bed/b1mem.h
Work on file usr/contrib/B/src/bed/bobj.h
Work on file usr/contrib/B/src/bed/cell.h
Work on file usr/contrib/B/src/bed/erro.h
Work on file usr/contrib/B/src/bed/eval.h
Work on file usr/contrib/B/src/bed/feat.h
Work on file usr/contrib/B/src/bed/file.h
Work on file usr/contrib/B/src/bed/gram.h
Work on file usr/contrib/B/src/bed/keys.h
Work on file usr/contrib/B/src/bed/node.h
Work on file usr/contrib/B/src/bed/queu.h
Work on file usr/contrib/B/src/bed/supr.h
Work on file usr/contrib/B/src/bed/syms.h
Work on file usr/contrib/B/src/bed/tabl.h
Work on file usr/contrib/B/src/bed/unix.h
Work on file usr/contrib/B/src/bed/vtrm.h
Work on file usr/contrib/B/src/bed/bobj.c
Work on file usr/contrib/B/src/bed/cell.c
Work on file usr/contrib/B/src/bed/comm.c
Work on file usr/contrib/B/src/bed/deco.c
Work on file usr/contrib/B/src/bed/demo.c
Work on file usr/contrib/B/src/bed/edit.c
Work on file usr/contrib/B/src/bed/erro.c
Work on file usr/contrib/B/src/bed/eval.c
Work on file usr/contrib/B/src/bed/file.c

Synthesized-from: CSRG/cd1/4.3

26 files changed:
usr/contrib/B/src/bed/b.h [new file with mode: 0644]
usr/contrib/B/src/bed/b1mem.h [new file with mode: 0644]
usr/contrib/B/src/bed/bobj.c [new file with mode: 0644]
usr/contrib/B/src/bed/bobj.h [new file with mode: 0644]
usr/contrib/B/src/bed/cell.c [new file with mode: 0644]
usr/contrib/B/src/bed/cell.h [new file with mode: 0644]
usr/contrib/B/src/bed/comm.c [new file with mode: 0644]
usr/contrib/B/src/bed/deco.c [new file with mode: 0644]
usr/contrib/B/src/bed/demo.c [new file with mode: 0644]
usr/contrib/B/src/bed/edit.c [new file with mode: 0644]
usr/contrib/B/src/bed/erro.c [new file with mode: 0644]
usr/contrib/B/src/bed/erro.h [new file with mode: 0644]
usr/contrib/B/src/bed/eval.c [new file with mode: 0644]
usr/contrib/B/src/bed/eval.h [new file with mode: 0644]
usr/contrib/B/src/bed/feat.h [new file with mode: 0644]
usr/contrib/B/src/bed/file.c [new file with mode: 0644]
usr/contrib/B/src/bed/file.h [new file with mode: 0644]
usr/contrib/B/src/bed/gram.h [new file with mode: 0644]
usr/contrib/B/src/bed/keys.h [new file with mode: 0644]
usr/contrib/B/src/bed/node.h [new file with mode: 0644]
usr/contrib/B/src/bed/queu.h [new file with mode: 0644]
usr/contrib/B/src/bed/supr.h [new file with mode: 0644]
usr/contrib/B/src/bed/syms.h [new file with mode: 0644]
usr/contrib/B/src/bed/tabl.h [new file with mode: 0644]
usr/contrib/B/src/bed/unix.h [new file with mode: 0644]
usr/contrib/B/src/bed/vtrm.h [new file with mode: 0644]

diff --git a/usr/contrib/B/src/bed/b.h b/usr/contrib/B/src/bed/b.h
new file mode 100644 (file)
index 0000000..3627ea4
--- /dev/null
@@ -0,0 +1,65 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: b.h,v 2.2 85/08/22 15:59:55 timo Exp $ */
+
+/*
+ * B editor -- Basics copied from B interpreter's run-time system.
+ */
+
+#include <stdio.h>
+
+#define Visible
+#define Hidden static
+#define Procedure
+
+typedef int bool;
+typedef short intlet;
+typedef char *string;
+
+#define No 0
+#define Yes 1
+
+#define Maxintlet ((1<<15)-1) /* MACHINE DEPENDENT */
+
+typedef struct {
+       char    type;
+       char    _unused;
+       intlet  refcnt;
+       intlet  len;
+       string  *cts;
+} *value;
+
+/* See also definitions in node.h and queu.h which must match the first
+   four fields of 'value'! */
+
+#define Refcnt(v) ((v)->refcnt)
+#define Type(v) ((v)->type)
+#define Length(v) ((v)->len)
+#define Str(v) ((char*)(&(v)->cts))
+
+#define Vnil ((value) NULL)
+
+/* Types: */
+#define Num '0'
+#define Tex '"'
+#define Com ','
+#define Nod 'N'
+#define Pat 'P'
+
+/*
+ * C library standard functions
+ */
+
+string malloc();
+string realloc();
+
+string sprintf();
+
+string strcpy();
+string strncpy();
+string index();
+string rindex();
+
+string getenv();
+
+#define Strequ(s, t) !strcmp(s, t)
+#define Strnequ(s, t, n) !strncmp(s, t, n)
diff --git a/usr/contrib/B/src/bed/b1mem.h b/usr/contrib/B/src/bed/b1mem.h
new file mode 100644 (file)
index 0000000..bb5a1a5
--- /dev/null
@@ -0,0 +1,20 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+
+/*
+  $Header: b1mem.h,v 1.1 85/08/22 15:44:29 timo Exp $
+*/
+
+/* bmem.h: B memory management */
+
+typedef char *ptr;
+#define Nil ((ptr) 0)
+
+#define getmem get_mem
+
+ptr getmem();
+/* Procedure regetmem(); */
+/* Procedure freemem(); */
+/* Procedure prgr(); */
+/* Procedure initmem(); */
+extern value notel; /*TEMPORARY*/
+extern bool noting; /*TEMPORARY*/
diff --git a/usr/contrib/B/src/bed/bobj.c b/usr/contrib/B/src/bed/bobj.c
new file mode 100644 (file)
index 0000000..e273eae
--- /dev/null
@@ -0,0 +1,645 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: bobj.c,v 2.5 85/08/22 15:59:59 timo Exp $";
+
+/*
+ * B editor -- A shrunken version of the B interpreter's run-time system.
+ */
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+
+#define COMPOUNDS
+
+string malloc();
+string calloc();
+string realloc();
+string strcpy();
+
+extern bool dflag;
+
+struct head {
+       char type;
+       intlet refcnt;
+       intlet len;
+};
+#define Intsize (sizeof(int))
+#define Hsize (sizeof(struct head))
+#define Headsize (((Hsize-1)/Intsize + 1) * Intsize)
+
+#define Field(v, i) (((value *)&(v)->cts)[i])
+
+#ifndef NDEBUG
+
+/* Statistics on allocation/sharing */
+
+int nobjs;
+int nrefs;
+
+#define Increfs ++nrefs
+#define Decrefs --nrefs
+
+#else NDEBUG
+
+#define Increfs 
+#define Decrefs 
+
+#endif NDEBUG
+
+
+#define Copy(v) if ((v) && Refcnt(v) < Maxintlet) { ++Refcnt(v); Increfs; }
+#define Release(v) if (!(v) || Refcnt(v) == Maxintlet) ; else RRelease(v)
+#define RRelease(v) \
+       if (Refcnt(v) > 1) { --Refcnt(v); Decrefs; } else release(v)
+
+
+/*
+ * Allocate a value with nbytes of data after the usual type, len, refcnt
+ * fields.
+ */
+
+value
+grabber(nbytes)
+       register int nbytes;
+{
+       register value v = (value) malloc((unsigned) (Headsize + nbytes));
+
+       if (!v)
+               syserr("grabber: malloc");
+#ifndef NDEBUG
+       if (dflag)
+               newval(v);
+#endif
+#ifndef NDEBUG
+       ++nobjs;
+#endif
+       Increfs;
+       v->refcnt = 1;
+       return v;
+}
+
+
+/*
+ * Reallocate a value with nbytes of data after the usual type, len, refcnt
+ * fields.
+ */
+
+value
+regrabber(v, nbytes)
+       register value v;
+       register int nbytes;
+{
+       Assert(v && v->refcnt == 1);
+       v = (value) realloc((char*)v, (unsigned) (Headsize + nbytes));
+       if (!v)
+               syserr("regrabber: realloc");
+       return v;
+}
+
+
+/*
+ * Set an object's refcnt to infinity, so it will never be released.
+ */
+
+fix(v)
+       register value v;
+{
+       register int i;
+       register node n;
+       register path p;
+
+       Assert(v->refcnt > 0);
+#ifndef NDEBUG
+       if (v->refcnt < Maxintlet)
+               nrefs -= v->refcnt;
+#endif
+       v->refcnt = Maxintlet;
+#if OBSOLETE
+       switch (v->type) {
+       case Tex:
+               break;
+       case Nod:
+               n = (node)v;
+               for (i = v->len - 1; i >= 0; --i)
+                       if (n->n_child[i])
+                               fix((value)(n->n_child[i]));
+               break;
+       case Pat:
+               p = (path)v;
+               if (p->p_parent)
+                       fix((value)(p->p_parent));
+               if (p->p_tree)
+                       fix((value)(p->p_tree));
+               break;
+#ifdef COMPOUNDS
+       case Com:
+               for (i = v->len-1; i >= 0; --i)
+                       if (Field(v, i))
+                               fix(Field(v, i));
+               break;
+#endif COMPOUNDS
+#ifdef SLOW_INTS
+       case Num:
+#endif SLOW_INTS
+       default:
+               Abort();
+       }
+#endif OBSOLETE
+}
+
+
+#ifdef COMPOUNDS
+/*
+ * Allocate a compound with n fields.
+ */
+
+Visible value
+grab_com(n)
+       int n;
+{
+       value v = grabber(n*sizeof(value));
+
+       v->type = Com;
+       v->len = n;
+       for (--n; n >= 0; --n)
+               Field(v, n) = Vnil;
+       return v;
+}
+#endif COMPOUNDS
+
+
+/*
+ * Allocate a node with nch children.
+ */
+
+node
+grab_node(nch)
+       register int nch;
+{
+       register node n = (node) grabber(
+                       sizeof(struct node) - Headsize +
+                       sizeof(value) * (nch-1));
+       register int i;
+
+       n->type = Nod;
+       n->len = nch;
+       n->n_marks = 0;
+       n->n_width = 0;
+       n->n_symbol = 0;
+       for (i = nch-1; i >= 0; --i)
+               n->n_child[i] = Nnil;
+       return n;
+}
+
+
+/*
+ * Allocate a path.
+ */
+
+path
+grab_path()
+{
+       register path p = (path) grabber(
+                       sizeof(struct path) - Headsize);
+
+       p->type = Pat;
+       p->p_parent = Pnil;
+       p->p_tree = Nnil;
+       p->p_ichild = 0;
+       p->p_ycoord = 0;
+       p->p_xcoord = 0;
+       p->p_level = 0;
+       p->p_addmarks = 0;
+       p->p_delmarks = 0;
+       return p;
+}
+
+
+#ifdef SLOW_INTS
+/*
+ * Make an integer.
+ */
+
+value
+mk_integer(i)
+       int i;
+{
+       value v;
+       static value tab[128];
+
+       if (!i)
+               return Vnil;
+       if (!(i&~127) && tab[i])
+               return tab[i];
+
+       v = grabber(sizeof(value));
+       v->type = Num;
+       Field(v, 0) = (value) i;
+       if (!(i&~127)) {
+               tab[i] = v;
+               v->refcnt = Maxintlet;
+       }
+       return v;
+}
+#endif SLOW_INTS
+
+
+/*
+ * Make a text object out of a C string.
+ */
+
+value
+mk_text(str)
+       register string str;
+{
+       register int len = strlen(str);
+       register value v = grabber(len+1);
+
+       v->type = Tex;
+       v->len = len;
+       strcpy(Str(v), str);
+       return v;
+}
+
+
+/*
+ * Concatenate a C string to a text object (at the end).
+ */
+
+concato(pv, str)
+       register value *pv;
+       register string str;
+{
+       register value v = *pv;
+       register int vlen = v->len;
+       register int len = strlen(str);
+
+       Assert(v && v->refcnt > 0);
+       if (!len)
+               return;
+
+       len += vlen;
+       if (v->refcnt == 1)
+               v = regrabber(v, len+1);
+       else {
+               v = grabber(len+1);
+               v->type = Tex;
+               strcpy(Str(v), Str(*pv));
+               Release(*pv);
+       }
+       strcpy(Str(v) + vlen, str);
+       v->len = len;
+       *pv = v;
+}
+
+
+/*
+ * Return a substring (trim) of a text object.
+ */
+
+value
+trim(v, behead, curtail)
+       register value v;
+       register int behead;
+       register int curtail;
+{
+       register value w;
+       register int c;
+
+       Assert(v && v->refcnt > 0);
+       Assert(behead >= 0 && curtail >= 0 && behead+curtail <= v->len);
+       if (behead + curtail == 0) {
+               Copy(v);
+               return v;
+       }
+
+       c = Str(v)[v->len - curtail];
+       Str(v)[v->len - curtail] = 0; /* TEMPORARILY */
+       w = mk_text(Str(v) + behead);
+       Str(v)[v->len - curtail] = c;
+       return w;
+}
+
+
+#ifdef SLOW_INTS
+/*
+ * Return the C value if an integer object.
+ */
+
+int
+intval(v)
+       register value v;
+{
+       if (!v)
+               return 0;
+       return (int) Field(v, 0);
+}
+#endif SLOW_INTS
+
+
+/*
+ * Make sure a location (pointer variable) contains a unique object.
+ */
+
+uniql(pv)
+       register value *pv;
+{
+       register value v = *pv;
+       register value w;
+       register path p;
+       register node n;
+       register int i;
+
+       Assert(v && v->refcnt > 0);
+       if (v->refcnt == 1)
+               return;
+
+       switch (v->type) {
+
+       case Nod:
+               n = grab_node(v->len);
+               for (i = v->len - 1; i >= 0; --i) {
+                       w = (value) (n->n_child[i] = ((node)v)->n_child[i]);
+                       Copy(w); /* This is ugly */
+               }
+               n->n_marks = ((node)v)->n_marks;
+               n->n_width = ((node)v)->n_width;
+               n->n_symbol = ((node)v)->n_symbol;
+               w = (value)n;
+               break;
+
+       case Pat:
+               p = grab_path();
+               p->p_parent = ((path)v)->p_parent;
+               Copy(p->p_parent);
+               p->p_tree = ((path)v)->p_tree;
+               Copy(p->p_tree);
+               p->p_ichild = ((path)v)->p_ichild;
+               p->p_ycoord = ((path)v)->p_ycoord;
+               p->p_xcoord = ((path)v)->p_xcoord;
+               p->p_level = ((path)v)->p_level;
+               w = (value)p;
+               break;
+
+#ifdef SLOW_INTS
+       case Num:
+               w = mk_integer(intval(v));
+               break;
+#endif SLOW_INTS
+
+#ifdef COMPOUNDS
+       case Com:
+               w = grab_com(v->len);
+               for (i = v->len - 1; i >= 0; --i) {
+                       n = (node) (Field(w, i) = Field(v, i));
+                       Copy(n); /* This is uglier */
+               }
+               break;
+#endif COMPOUNDS
+
+       case Tex:
+               w = mk_text(Str(v));
+               break;
+
+       default:
+               Abort();
+
+       }
+       Release(v);
+       *pv = w;
+}
+
+
+/*
+ * Increase the reference count of an object, unless it is infinite.
+ */
+
+value
+copy(v)
+       value v;
+{
+       if (!v)
+               return v;
+
+       Assert(v->refcnt > 0);
+       if (v->refcnt < Maxintlet) {
+               ++v->refcnt;
+               Increfs;
+       }
+       return v;
+}
+
+
+/*
+ * Decrease the reference count of an object, unless it is infinite.
+ * If it reaches zero, free the storage occupied by the object.
+ */
+
+release(v)
+       register value v;
+{
+       register int i;
+       register value w;
+
+       if (!v)
+               return;
+       Assert(v->refcnt > 0);
+       if (v->refcnt == Maxintlet)
+               return;
+
+       Decrefs;
+       --v->refcnt;
+       if (v->refcnt == 0) {
+               switch (v->type) {
+#ifdef SLOW_INTS
+               case Num:
+#endif SLOW_INTS
+               case Tex:
+                       break;
+#ifdef COMPOUNDS
+               case Com:
+                       for (i = v->len - 1; i >= 0; --i) {
+                               w = Field(v, i);
+                               Release(w);
+                       }
+                       break;
+#endif COMPOUNDS
+               case Nod:
+                       for (i = v->len - 1; i >= 0; --i) {
+                               w = (value)(((node)v)->n_child[i]);
+                               Release(w);
+                       }
+                       break;
+               case Pat:
+                       w = (value)(((path)v)->p_parent);
+                       Release(w);
+                       w = (value)(((path)v)->p_tree);
+                       Release(w);
+                       break;
+               default:
+                       Abort();
+               }
+#ifndef NDEBUG
+               if (dflag)
+                       delval(v);
+               --nobjs;
+#endif NDEBUG
+               free((string)v);
+       }
+}
+
+objstats()
+{
+#ifndef NDEBUG
+       fprintf(stderr, "*** Object statistics: %d objects, %d references\n",
+               nobjs, nrefs);
+#ifdef MSTATS
+       mstats("(at end)"); /* A routine which some malloc versions have to print
+                    memory statistics. Remove if your malloc hasn't. */
+#endif MSTATS
+#endif NDEBUG
+}
+
+#ifndef NDEBUG
+valdump(v)
+       value v;
+{
+       if (!v)
+               fputs("(nil)", stderr);
+       else {
+               fprintf(stderr, "v=0x%x, type='%c', len=%d, refcnt=",
+                       v, v->type, v->len);
+               if (v->refcnt == Maxintlet)
+                       putc('*', stderr);
+               else
+                       fprintf(stderr, "%d", v->refcnt);
+               fputs(": ", stderr);
+               wrval(v);
+
+       }
+       putc('\n', stderr);
+}
+
+#define QUOTE '\''
+
+wrval(v)
+       value v;
+{
+       register string cp;
+       register int c;
+
+       if (!v) {
+               fputs("nil", stderr);
+               return;
+       }
+
+       switch (v->type) {
+
+#ifdef SLOW_INTS
+       case Num:
+               fprintf(stderr, "%d", intval(v));
+               break;
+#endif SLOW_INTS
+
+       case Tex:
+               putc(QUOTE, stderr);
+               for (cp = Str(v); c = *cp; ++cp) {
+                       if (' ' <= c && c < 0177) {
+                               putc(c, stderr);
+                               if (c == QUOTE)
+                                       putc(c, stderr);
+                       }
+                       else if (0 <= c && c < ' ')
+                               putc('^', stderr), putc(c + '@', stderr);
+                       else
+                               fprintf(stderr, "\\%03o", c);
+               }
+               putc(QUOTE, stderr);
+               break;
+
+#ifdef COMPOUNDS
+       case Com:
+         {
+               int i;
+               value f;
+               putc('(', stderr);
+               for (i = 0; i < v->len; ++i) {
+                       if (i)
+                               putc(',', stderr), putc(' ', stderr);
+                       f = Field(v, i);
+                       if (!f || f->refcnt == 1 || f->type != Com) {
+                               if (f && f->type == Com)
+                                       fprintf(stderr, "0x%x=", f);
+                               wrval(f);
+                       }
+                       else
+                               fprintf(stderr, "0x%x", f);
+               }
+               putc(')', stderr);
+               break;
+         }
+#endif COMPOUNDS
+
+       default:
+               fprintf(stderr, "0x%x", v);
+
+       }
+}
+
+static struct list {
+       struct list *link;
+       value val;
+} head;
+#endif NDEBUG
+
+objdump()
+{
+#ifndef NDEBUG
+       struct list *l;
+
+       for (l = head.link; l; l = l->link)
+               valdump(l->val);
+#endif NDEBUG
+}
+
+objcheck()
+{
+#ifndef NDEBUG
+       struct list *l;
+
+       for (l = head.link; l; l = l->link)
+               if (l->val->refcnt != Maxintlet)
+                       valdump(l->val);
+#endif NDEBUG
+}
+
+#ifndef NDEBUG
+newval(v)
+       register value v;
+{
+       register struct list *l =
+                       (struct list *) malloc((unsigned) sizeof(struct list));
+
+       if (!l)
+               syserr("newval: malloc");
+       l->link = head.link;
+       l->val = v;
+       head.link = l;
+}
+
+delval(v)
+       register value v;
+{
+       register struct list *l;
+       register struct list *p;
+
+       for (p = &head, l = head.link; l; p = l, l = l->link) {
+               if (l->val == v) {
+                       p->link = l->link;
+                       free((string)l);
+                       return;
+               }
+       }
+       Abort();
+}
+#endif NDEBUG
diff --git a/usr/contrib/B/src/bed/bobj.h b/usr/contrib/B/src/bed/bobj.h
new file mode 100644 (file)
index 0000000..6446dc4
--- /dev/null
@@ -0,0 +1,21 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: bobj.h,v 2.0 84/06/18 15:46:31 guido Exp $ */
+
+/*
+ * B editor -- Interface to "B machine".
+ */
+
+/*
+ * General values.
+ */
+
+value grab_com();
+value copy();
+
+/*
+ * Operations on texts.
+ */
+
+value mk_text();
+value trim();
+value concat();
diff --git a/usr/contrib/B/src/bed/cell.c b/usr/contrib/B/src/bed/cell.c
new file mode 100644 (file)
index 0000000..a507808
--- /dev/null
@@ -0,0 +1,329 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: cell.c,v 2.4 85/02/12 11:18:00 timo Exp $";
+
+/*
+ * B editor -- Screen management package, cell list manipulation routines.
+ */
+
+#include "b.h"
+#include "bobj.h"
+#include "node.h"
+#include "eval.h"
+#include "cell.h"
+
+
+extern bool dflag;
+extern bool noscroll;
+
+/*
+ * Definitions for internals of cell manipulations.
+ */
+
+Hidden cell *freelist;
+
+#define CELLSIZE (sizeof(cell))
+
+#ifndef PAGESIZE /* 4.2 BSD freaks compile with -DPAGESIZE='getpagesize()' */
+#define PAGESIZE 1024
+#endif
+
+#ifndef MALLOCLOSS
+#define MALLOCLOSS (sizeof(char*))
+       /* number of bytes taken by malloc administration per block */
+#endif
+
+
+/*
+ * Replace `oldlcnt' cells from `tops', starting at the one numbered `oldlno',
+ * by the list `rep'.
+ * Returns a pointer to the deleted chain (with a Nil end pointer).
+ */
+
+Visible cell *
+replist(tops, rep, oldlno, oldlcnt)
+       cell *tops;
+       cell *rep;
+       int oldlno;
+       register int oldlcnt;
+{
+       cell head;
+       register cell *p;
+       register cell *q;
+       register cell *old;
+       register cell *end;
+       register int diff;
+       int i;
+       int replcnt;
+
+       if (!tops) /* Start with empty list */
+               return rep;
+       head.c_link = tops;
+       p = &head;
+       for (diff = oldlno; diff > 0; --diff) {
+               p = p->c_link;
+               Assert(p);
+       }
+       q = p;
+       for (i = oldlcnt; i > 0 && p; --i)
+               p = p->c_link;
+       if (i > 0) {
+#ifndef NDEBUG
+               debug("[replist jackpot]");
+#endif NDEBUG
+               oldlcnt -= i;
+       }
+       old = q->c_link;
+       q->c_link = rep;
+       if (p) {
+               end = p->c_link;
+               p->c_link = Cnil;
+       }
+       for (replcnt = 0; q->c_link; ++replcnt, q = q->c_link)
+               ;
+       dupmatch(old, rep, oldlcnt, replcnt);
+       discard(old);
+       if (p)
+               q->c_link = end;
+       return head.c_link;
+}
+
+
+/*
+ * Allocate a new cell.
+ */
+
+Hidden cell *
+newcell()
+{
+       register cell *p;
+
+       if (!freelist)
+               feedfreelist();
+       p = freelist;
+       freelist = p->c_link;
+       p->c_link = Cnil;
+       return p;
+}
+
+
+/*
+ * Feed the free list with a block of new entries.
+ * We try to keep them together on a page
+ * to keep consecutive accesses fast.
+ */
+
+Hidden Procedure
+feedfreelist()
+{
+       register int n = (PAGESIZE-MALLOCLOSS) / CELLSIZE;
+       register cell *p = (cell*) malloc((unsigned)(n*CELLSIZE));
+
+       Assert(n > 0);
+       if (!p)
+               syserr("feedfreelist: malloc");
+       freelist = p;
+       for (; n > 1; --n, ++p)
+               p->c_link = p+1;
+       p->c_link = Cnil;
+}
+
+
+/*
+ * Discard all entries of a list of cells.
+ */
+
+Visible Procedure
+discard(p)
+       register cell *p;
+{
+       register cell *savefreelist;
+
+       if (!p)
+               return;
+       savefreelist = p;
+       for (;;) {
+               noderelease(p->c_data);
+               p->c_data = Nnil;
+               if (!p->c_link)
+                       break;
+               p = p->c_link;
+       }
+       p->c_link = freelist;
+       freelist = savefreelist;
+}
+
+
+/*
+ * Replace the `onscreen' fields in the replacement chain by those
+ * in the old chain, if they match.
+ */
+
+Hidden Procedure
+dupmatch(old, rep, oldcnt, repcnt)
+       register cell *old;
+       register cell *rep;
+       int oldcnt;
+       int repcnt;
+{
+       register int diff = repcnt - oldcnt;
+
+#ifndef NDEBUG
+       if (dflag)
+               debug("[dupmatch(oldcnt=%d, newcnt=%d)]", oldcnt, repcnt);
+#endif NDEBUG
+       while (rep && old) {
+               if (old->c_length == rep->c_length
+                       && eqlines(old->c_data, rep->c_data)) {
+                       if (old->c_onscreen != Nowhere) {
+                               rep->c_onscreen = old->c_onscreen;
+                               rep->c_oldindent = old->c_oldindent;
+                               rep->c_oldvhole = old->c_oldvhole;
+                               rep->c_oldfocus = old->c_oldfocus;
+                       }
+                       rep = rep->c_link;
+                       old = old->c_link;
+               }
+               else {
+                       if (diff >= 0) {
+                               --diff;
+                               rep = rep->c_link;
+                       }
+                       if (diff < 0) {
+                               ++diff;
+                               old = old->c_link;
+                       }
+               }
+       }
+}
+
+
+/*
+ * Build a list of cells consisting of the first `lcnt' lines of the tree.
+ */
+
+Visible cell *
+build(p, lcnt)
+       /*auto*/ path p;
+       register int lcnt;
+{
+       cell head;
+       register cell *q = &head;
+
+       p = pathcopy(p);
+       for (;;) {
+               q = q->c_link = newcell();
+               q->c_onscreen = Nowhere;
+               q->c_data = nodecopy(tree(p));
+               q->c_length = linelen(q->c_data);
+               q->c_newindent = Level(p) * TABS;
+               q->c_oldindent = 0;
+               q->c_oldvhole = q->c_newvhole = q->c_oldfocus = q->c_newfocus = No;
+               --lcnt;
+               if (lcnt <= 0)
+                       break;
+               nextline(&p) || Abort();
+       }
+       q->c_link = Cnil;
+       pathrelease(p);
+       return head.c_link;
+}
+
+
+/*
+ * Decide which line is to be on top of the screen.
+ * We slide a window through the list of lines, recognizing
+ * lines of the focus and lines already on the screen,
+ * and stop as soon as we find a reasonable focus position.
+ *
+ * - The focus must always be on the screen completely;
+ *   if it is larger than the screen, its first line must be
+ *   on top of the screen.
+ * - When old lines can be retained, at least one line above
+ *   and below the focus must be shown; the retained lines
+ *   should be moved as little as possible.
+ * - As little as possible blank space should be shown at the
+ *   bottom, even if the focus is at the end of the unit.
+ * - If no rule applies, try to center the focus on the screen.
+ * - If noscroll is Yes (the terminal can't scroll), and the top
+ *   line can't be retained, also try to center the focus on the
+ *   screen.
+ */
+
+Visible cell *
+gettop(tops)
+       cell *tops;
+{
+       register cell *pfwa = tops; /* First line of sliding window */
+       register cell *plwa = tops; /* Last+1 line of sliding window */
+       register cell *pffocus = Cnil; /* First line of focus */
+       cell *pscreen = Cnil; /* First line still on screen */
+       register int nfwa = 0; /* Corresponding line numbers in parse tree */
+       register int nlwa = 0;
+       register int nffocus;
+       int nlfocus;
+       int nscreen;
+       int size;
+
+       for (;;) { /* plwa is the current candidate for top line. */
+               if (!pfwa) {
+#ifndef NDEBUG
+                       debug("[Lost the focus!]");
+#endif NDEBUG
+                       return tops; /* To show *something*... */
+               }
+               while (plwa && nlwa < nfwa+winheight) {
+                       /* Find first line *not* in window */
+                       size = Space(plwa);
+                       if (plwa->c_newfocus) { /* Hit a focus line */
+                               if (!pffocus) { /* Note first focus line */
+                                       pffocus = plwa;
+                                       nffocus = nlwa;
+                               }
+                               nlfocus = nlwa + size;
+                       }
+                       if (plwa->c_onscreen != Nowhere) { /* Hello old chap */
+                               if (!pscreen) { /* Note first line on screen */
+                                       pscreen = plwa;
+                                       nscreen = nlwa;
+                               }
+                       }
+                       nlwa += size;
+                       plwa = plwa->c_link;
+               }
+               if (pffocus) {
+                       /* Focus in sight; stop at first reasonable opportunity */
+                       if (pffocus == pfwa)
+                               break; /* Grab last chance! */
+                       if (!noscroll && nlwa - nfwa <= winheight - winheight/3)
+                               break; /* Don't show too much white space at bottom */
+                       if (pffocus == pfwa->c_link && nlfocus < nfwa+winheight)
+                               break; /* Near top line */
+                       if (pscreen && (!noscroll || nffocus > nscreen)) {
+                               /* Conservatism may succeed */
+                               if (pscreen->c_onscreen >= nscreen - nfwa
+                                       && (nlfocus < nfwa+winheight
+                                               || !plwa && nlfocus == nfwa+winheight))
+                                       break; /* focus entirely on screen */
+                       }
+                       else { /* No comrades seen */
+                               if (nffocus - nfwa <= nfwa+winheight - nlfocus
+                                       || !plwa && nlwa <= nfwa+winheight)
+                                       break; /* Nicely centered focus or end of unit */
+                       }
+               }
+               if (pfwa == pscreen) { /* Say farewell to oldest comrade */
+                       pscreen->c_onscreen = Nowhere;
+                       do { /* Find next in age */
+                               nscreen += Space(pscreen);
+                               pscreen = pscreen->c_link;
+                               if (pscreen == plwa) {
+                                       pscreen = Cnil;
+                                       break;
+                               }
+                       } while (pscreen->c_onscreen == Nowhere);
+               }
+               nfwa += Space(pfwa);
+               pfwa = pfwa->c_link; /* Pass the buck */
+       }
+       return pfwa; /* This is what all those breaks aim at */
+}
diff --git a/usr/contrib/B/src/bed/cell.h b/usr/contrib/B/src/bed/cell.h
new file mode 100644 (file)
index 0000000..e9a0280
--- /dev/null
@@ -0,0 +1,39 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: cell.h,v 2.0 84/06/18 15:46:34 guido Exp $ */
+
+/*
+ * B editor -- Definitions for linked lists of screen lines, baptized `cells'.
+ * (This is NOT an abstract data type!)
+ */
+
+struct cell {
+       struct cell *c_link;
+       node c_data;
+       short c_onscreen;
+       short c_oldindent;
+       short c_newindent;
+       short c_length;
+       char c_oldvhole;
+       char c_newvhole; /* Yes if this line contains a `vhole' */
+       char c_oldfocus;
+       char c_newfocus; /* Yes if this line contains underlining */
+};
+
+typedef struct cell cell;
+
+#define Cnil ((cell*) NULL)
+
+#define Nowhere (-9999)
+
+#define SpaceRound(x) ((indent + (x) + llength - 1) / llength)
+#define Space(p) \
+       SpaceRound((p)->c_length + (p)->c_newindent + (p)->c_newvhole)
+#define Oldspace(p) \
+       SpaceRound((p)->c_length + (p)->c_newindent + (p)->c_newvhole)
+
+cell *replist();
+cell *build();
+
+extern int llength;
+extern int winheight;
+extern int indent;
diff --git a/usr/contrib/B/src/bed/comm.c b/usr/contrib/B/src/bed/comm.c
new file mode 100644 (file)
index 0000000..c9bedc9
--- /dev/null
@@ -0,0 +1,396 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: comm.c,v 2.4 85/08/22 16:00:49 timo Exp $";
+
+/*
+ * B editor -- Communication with B interpreter.
+ */
+
+#include "feat.h"
+#ifdef BTOP
+
+#include <signal.h>
+#include <setjmp.h>
+#include <ctype.h>
+
+#include "b.h"
+#include "node.h"
+#include "supr.h"
+#include "unix.h"
+#include "cell.h" /* For winheight */
+
+#define TABS 8
+
+string unixerror();
+
+
+/*
+ * Communication to other modules (demo, getc, ...):
+ */
+
+Visible bool interrupted; /* Set when interrupt caught but not propagated */
+Visible bool canjump; /* Set when disrupt() can safely longjmp(jumpback) */
+Visible jmp_buf jumpback; /* Set by other module where to jump */
+
+/*
+ * Pipeline protocol with interpreter:
+ */
+
+#define ESCAPE '\001' /* Character signalling special function */
+#define RESYNC '\177' /* Character signalling acknowledge of interrupt */
+#define INTRCHILD SIGTRAP /* Signal to send as interrupt */
+
+#ifndef INTERPRETER
+#define INTERPRETER "/usr/new/lib/B/bint"
+#endif
+
+/*
+ * Local definitions:
+ */
+
+#ifndef INTRMSG
+#define INTRMSG "*** Interrupted" /* Acknowledges interrupt */
+#endif INTRMSG
+
+#define Moreinput(stream) ((stream)->_cnt > 0)
+
+Hidden int fdown[2]; /* File descriptors for pipe down */
+Hidden int fup[2]; /* Pipe up */
+
+Hidden int pid; /* Process id of child */
+
+Hidden FILE *pdown; /* FILE pointer for pipe down to child process */
+Hidden FILE *pup; /* Pipe up */
+
+Hidden string interpreter; /* Name of interpreter to be used */
+
+
+Hidden char pushback[100]; /* Limited pushback facility */
+Hidden int npushback; /* Number of characters pushed back */
+
+
+/*
+ * Routine to set canjump, do a getc, and clear canjump.
+ */
+
+Visible int
+ffgetc(fp)
+       FILE *fp;
+{
+       register int c;
+
+       canjump = Yes;
+       c = getc(fp);
+       canjump = No;
+       return c;
+}
+
+
+/*
+ * Similar for fgets.
+ */
+
+Visible string
+ffgets(buf, len, fp)
+       string buf;
+       int len;
+       FILE *fp;
+{
+       canjump = Yes;
+       buf = fgets(buf, len, fp);
+       canjump = No;
+       return buf;
+}
+
+
+/*
+ * Assign values to `fdown' and `fup'.
+ */
+
+Hidden Procedure
+getdevices()
+{
+       if (pipe(fdown) < 0 || pipe(fup) < 0)
+               syserr("%s", unixerror("can't pipe"));
+}
+
+
+/*
+ * Do the magic required for child-birth.
+ */
+
+Hidden Procedure
+makechild()
+{
+#ifdef VFORK
+       pid = vfork();
+#else VFORK
+       pid = fork();
+#endif VFORK
+       if (pid == -1)
+               syserr("%s", unixerror("can't fork"));
+       if (pid == 0) /* Child */
+               exec_b(); /* Does not return */
+       /* Parent */
+       close(fdown[0]);
+       close(fup[1]);
+}
+
+
+/*
+ * Code executed in the child process.  Never returns.
+ * Just dup the pipe ends to files 0, a and 2 (stdin, stdout and stderr),
+ * then close the original pipes.
+ */
+
+Hidden Procedure
+exec_b()
+{
+       close(fdown[1]), close(fup[0]);
+       close(0), close(1), close(2);
+       dup(fdown[0]), dup(fup[1]), dup(fup[1]);
+       close(fdown[0]), close(fup[1]);
+       execl(interpreter, interpreter, "-i", (char*)NULL);
+       fprintf(stderr, "*** ");
+       perror(interpreter);
+       _exit(1);
+}
+
+
+/*
+ * Interrupt handler.
+ * Usually only the flag `interrupted' is set.
+ *
+ * When `canjump' is on, it is cleared and we do a longjmp
+ * back to where jumpbuf leads us (usually done when a read
+ * system call is interrupted, as 4.2BSD tends to continue
+ * these rather than have them return with errno = EINTR).
+ */
+
+Hidden Procedure
+disrupt()
+{
+       interrupted = Yes;
+       signal(SIGINT, disrupt);
+       if (canjump) {
+               canjump = No;
+               longjmp(jumpback, 1);
+       }
+}
+
+
+/*
+ * Start the B interpreter as a subprocess.
+ * Set up communication pipes in pdown, pup.
+ */
+
+Visible Procedure
+start_b(ppdown, ppup)
+       FILE **ppdown;
+       FILE **ppup;
+{
+       interpreter = getenv("B_INTERPRETER");
+       if (!interpreter)
+               interpreter = INTERPRETER;
+       getdevices();
+       makechild();
+       pdown = fdopen(fdown[1], "w");
+       pup = fdopen(fup[0], "r");
+       if (!pdown || !pup)
+               syserr("%s", unixerror("can't fdopen"));
+       *ppdown = pdown;
+       *ppup = pup;
+       signal(SIGINT, disrupt);
+}
+
+
+/*
+ * Routine to be called after each line of data has been passed
+ * to the B interpreter; it checks whether the immediate next
+ * output is a request for an immediate command, and if so,
+ * eats the request and returns Yes.  Otherwise it pushes back the
+ * request for later processing by sleur(), and returns No.
+ * ***** The prompt parameter is a relict of old times. *****
+ */
+
+Visible bool
+expect(prompt)
+       string prompt; /* Only first char used; should be ">" */
+{
+       register int c;
+
+       fflush(pdown);
+       if (setjmp(jumpback))
+               return No;
+       if (npushback)
+               c = pushback[--npushback];
+       else
+               c = ffgetc(pup);
+       if (c != ESCAPE) {
+               if (c != EOF)
+                       pushback[npushback++] = c;
+               return No;
+       }
+       if (npushback)
+               c = pushback[--npushback];
+       else
+               c = ffgetc(pup);
+       if (c == *prompt)
+               return Yes;
+       if (c != EOF)
+               pushback[npushback++] = c;
+       pushback[npushback++] = ESCAPE;
+       return No;
+}
+
+
+Visible int
+sleur()
+{
+       register int c;
+       register int x = 0;
+       bool show = Yes; /* No when looking for interrupt sync char */
+       bool idle = Yes; /* Yes when no output done yet this call */
+
+       fflush(pdown);
+
+       for (;;) {
+               if (interrupted) {
+                       interrupted = No;
+                       intrchild();
+                       show = No;
+               }
+               if (show && npushback == 0 && !Moreinput(pup))
+                       fflush(stdout);
+               if (setjmp(jumpback))
+                       continue;
+               if (npushback > 0)
+                       c = pushback[--npushback];
+               else
+                       c = ffgetc(pup);
+               if (c == EOF) { /* End-of-file: B interpreter has terminated. */
+                       fflush(stdout);
+                       return EOF;
+               }
+               if (c == RESYNC) {
+                       /* B interpreter acknowledges interrupt. */
+                       if (!show) {
+                               if (x != 0) putchar('\n');
+                               fputs(INTRMSG, stdout);
+                               putchar('\n');
+                               x = 0;
+                               show = Yes;
+                       }
+                       continue;
+               }
+               if (show) {
+                       if (c != ESCAPE) {
+                               putchar(c);
+                               switch (c) {
+                               case '\t':
+                                       x = (x/TABS + 1)*TABS;
+                                       break;
+                               case '\b':
+                                       if (x > 0) --x;
+                                       break;
+                               case '\r':
+                               case '\n':
+                                       x = 0;
+                                       break;
+                               default:
+                                       if (isascii(c) && isprint(c)
+                                               || c == ' ') ++x;
+                                       break;
+                               }
+                       }
+                       else {
+                               /* Control-A: B interpreter needs input. */
+                               if (setjmp(jumpback))
+                                       continue;
+                               if (npushback)
+                                       c = pushback[--npushback];
+                               else {
+                                       c = ffgetc(pup);
+                                       if (c == EOF) {
+                                               return EOF;
+                                       }
+                               }
+                               if (c == '>') {
+                                       /* Newline before command prompt */
+                                       if (x != 0) putchar('\n');
+                                       x = 0;
+                               }
+                               setindent(x);
+                               fflush(stdout);
+                               return c;
+                       }
+               }
+       }
+}
+
+
+/*
+ * Send the child a termination signal (SIGTERM).
+ */
+
+Visible Procedure
+termchild()
+{
+       if (pid) {
+               kill(pid, SIGTERM);
+               pid = 0;
+       }
+}
+
+
+/*
+ * Send the child an interrupt signal.  (By convention, this is SIGTRAP).
+ */
+
+Visible Procedure
+intrchild()
+{
+       if (pid) {
+               kill(pid, INTRCHILD);
+               fflush(stdout);
+       }
+}
+
+
+/*
+ * Wait for child process and report abnormal exit statuses.
+ */
+
+Visible Procedure
+waitchild()
+{
+       int k;
+       int status;
+
+       if (pid) {
+               while ((k = wait(&status)) != -1) {
+                       if (k != pid)
+#ifndef SMALLSYS
+                               fprintf(stderr, "*** [Pid %d status 0%o]\n", pid, status)
+#endif SMALLSYS
+                               ;
+                       else {
+#ifndef SMALLSYS
+                               if (status&0377)
+                                       fprintf(stderr, "*** Interpreter killed by signal %d%s\n",
+                                               status&0177, status&0200 ? " - core dumped" : "");
+                               else if (status)
+                                       fprintf(stderr, "*** Interpreter exit(%d)\n", status>>8);
+#endif SMALLSYS
+                               pid = 0;
+                               break;
+                       }
+               }
+#ifndef SMALLSYS
+               if (pid)
+                       fprintf(stderr, "*** Can't get interpreter status\n");
+#endif SMALLSYS
+               pid = 0;
+       }
+}
+
+#endif BTOP
diff --git a/usr/contrib/B/src/bed/deco.c b/usr/contrib/B/src/bed/deco.c
new file mode 100644 (file)
index 0000000..52a35da
--- /dev/null
@@ -0,0 +1,678 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: deco.c,v 2.3 84/07/19 11:45:12 guido Exp $";
+
+/*
+ * B editor -- Delete and copy commands.
+ */
+
+#include <ctype.h>
+
+#include "b.h"
+#include "erro.h"
+#include "bobj.h"
+#include "node.h"
+#include "gram.h"
+#include "supr.h"
+#include "queu.h"
+
+
+value copyout(); /* Forward */
+
+/*
+ * DELETE and COPY currently share a buffer, called the copy buffer.
+ * (Physically, there is one such a buffer in each environment.)
+ * In ordinary use, the copy buffer receives the text deleted by the
+ * last DELETE command (unless it just removed a hole); the COPY command
+ * can then be used (with the focus on a hole) to copy it back.
+ * When some portion of text must be held while other text is deleted,
+ * the COPY command again, but now with the focus on the text to be held,
+ * copies it to the buffer and deleted text won't overwrite the buffer
+ * until it is copied back at least once.
+ * If the buffer holds text that was explicitly copied out but not yet
+ * copied back in, it is saved on a file when the editor exits, so it can
+ * be used in the next session; but this is not true for text implicitly
+ * placed in the buffer through DELETE.
+ */
+
+/*
+ * Delete command -- delete the text in the focus, or delete the hole
+ * if it is only a hole.
+ */
+
+Visible bool
+delete(ep)
+       register environ *ep;
+{
+       higher(ep);
+       shrink(ep);
+       if (ishole(ep))
+               return delhole(ep);
+       if (!ep->copyflag) {
+               release(ep->copybuffer);
+               ep->copybuffer = copyout(ep);
+       }
+       return delbody(ep);
+}
+
+
+/*
+ * Delete the focus under the assumption that it contains some text.
+ */
+
+Visible bool
+delbody(ep)
+       register environ *ep;
+{
+       ep->changed = Yes;
+
+       subgrow(ep, No); /* Don't ignore spaces */
+       switch (ep->mode) {
+
+       case SUBRANGE:
+               if (ep->s1&1)
+                       return delfixed(ep);
+               return delvarying(ep);
+
+       case SUBSET:
+               return delsubset(ep, Yes);
+
+       case SUBLIST:
+               return delsublist(ep);
+
+       case WHOLE:
+               return delwhole(ep);
+
+       default:
+               Abort();
+               /* NOTREACHED */
+       }
+}
+
+
+/*
+ * Delete portion (ep->mode == SUBRANGE) of varying text ((ep->s1&1) == 0).
+ */
+
+Hidden bool
+delvarying(ep)
+       register environ *ep;
+{
+       auto queue q = Qnil;
+       register node n = tree(ep->focus);
+       auto value v = (value) child(n, ep->s1/2);
+       register len = Length(v);
+
+       Assert(ep->mode == SUBRANGE && !(ep->s1&1)); /* Wrong call */
+       Assert(Type(v) == Tex); /* Inconsistent parse tree */
+       if (ep->s2 == 0
+               && !mayinsert(tree(ep->focus), ep->s1/2, 0, Str(v)[ep->s3 + 1])) {
+               /* Cannot do simple substring deletion. */
+               stringtoqueue(Str(v) + ep->s3 + 1, &q);
+               delfocus(&ep->focus);
+               ep->mode = WHOLE;
+               return app_queue(ep, &q);
+       }
+       v = copy(v);
+       putintrim(&v, ep->s2, len - ep->s3 - 1, "");
+       s_downi(ep, ep->s1/2);
+       replace(&ep->focus, (node) v);
+       s_up(ep);
+       ep->mode = VHOLE;
+       return Yes;
+}
+
+
+/*
+ * Delete portion (ep->mode == SUBRANGE) of fixed text ((ep->s1&1) == 1).
+ */
+
+Hidden bool
+delfixed(ep)
+       register environ *ep;
+{
+       register node n = tree(ep->focus);
+       char buf[15]; /* Long enough for all fixed texts */
+       register string repr = noderepr(n)[ep->s1/2];
+       register int len;
+       queue q = Qnil;
+       bool ok;
+
+       Assert(ep->mode == SUBRANGE && (ep->s1&1));
+       if (ep->s1 > 1) {
+               ep->mode = FHOLE;
+               return Yes;
+       }
+       Assert(fwidth(repr) < sizeof buf - 1);
+       len = ep->s2;
+       ep->s2 = ep->s3 + 1;
+       ep->mode = FHOLE;
+       nosuggtoqueue(ep, &q);
+       strcpy(buf, repr);
+       if (nchildren(tree(ep->focus)) > 0)
+               buf[len] = 0;
+       else
+               strcpy(buf+len, buf+ep->s2);
+       delfocus(&ep->focus);
+       ep->mode = WHOLE;
+       markpath(&ep->focus, 1);
+       ok = ins_string(ep, buf, &q, 0);
+       if (!ok) {
+               qrelease(q);
+               return No;
+       }
+       firstmarked(&ep->focus, 1) || Abort();
+       unmkpath(&ep->focus, 1);
+       fixfocus(ep, len);
+       return app_queue(ep, &q);
+}
+
+
+/*
+ * Delete focus if ep->mode == SUBSET.
+ */
+
+Hidden bool
+delsubset(ep, hack)
+       register environ *ep;
+       bool hack;
+{
+       auto queue q = Qnil;
+       auto queue q2 = Qnil;
+       register node n = tree(ep->focus);
+       register node nn;
+       register string *rp = noderepr(n);
+       register int nch = nchildren(n);
+       register int i;
+
+       if (hack) {
+               shrsubset(ep);
+               if (ep->s1 == ep->s2 && !(ep->s1&1)) {
+                       nn = child(tree(ep->focus), ep->s1/2);
+                       if (fwidth(noderepr(nn)[0]) < 0) {
+                               /* It starts with a newline, leave the newline */
+                               s_downi(ep, ep->s1/2);
+                               ep->mode = SUBSET;
+                               ep->s1 = 2;
+                               ep->s2 = 2*nchildren(nn) + 1;
+                               return delsubset(ep, hack);
+                       }
+               }
+               subgrsubset(ep, No); /* Undo shrsubset */
+               if (ep->s2 == 3 && rp[1] && Strequ(rp[1], "\t"))
+                       --ep->s2; /* Hack for deletion of unit-head or if/for/wh. head */
+       }
+       if (ep->s1 == 1 && Fw_negative(rp[0]))
+               ++ep->s1; /* Hack for deletion of test-suite or refinement head */
+
+       if (Fw_zero(rp[0]) ? (ep->s2 < 3 || ep->s1 > 3) : ep->s1 > 1) {
+               /* No deep structural change */
+               for (i = (ep->s1+1)/2; i <= ep->s2/2; ++i) {
+                       s_downi(ep, i);
+                       delfocus(&ep->focus);
+                       s_up(ep);
+               }
+               if (ep->s1&1) {
+                       ep->mode = FHOLE;
+                       ep->s2 = 0;
+               }
+               else if (Type(child(tree(ep->focus), ep->s1/2)) == Tex) {
+                       ep->mode = VHOLE;
+                       ep->s2 = 0;
+               }
+               else {
+                       s_downi(ep, ep->s1/2);
+                       ep->mode = ATBEGIN;
+               }
+               return Yes;
+       }
+
+       balance(ep); /* Make balanced \t - \b pairs */
+       subsettoqueue(n, 1, ep->s1-1, &q);
+       subsettoqueue(n, ep->s2+1, 2*nch+1, &q2);
+       nonewline(&q2); /* Wonder what will happen...? */
+       delfocus(&ep->focus);
+       ep->mode = ATBEGIN;
+       leftvhole(ep);
+       if (!ins_queue(ep, &q, &q2)) {
+               qrelease(q2);
+               return No;
+       }
+       return app_queue(ep, &q2);
+}
+
+
+/*
+ * Delete the focus if ep->mode == SUBLIST.
+ */
+
+delsublist(ep)
+       register environ *ep;
+{
+       register node n;
+       register int i;
+       register int sym;
+       queue q = Qnil;
+       bool flag;
+
+       Assert(ep->mode == SUBLIST);
+       n = tree(ep->focus);
+       flag = fwidth(noderepr(n)[0]) < 0;
+       for (i = ep->s3; i > 0; --i) {
+               n = lastchild(n);
+               Assert(n);
+       }
+       if (flag) {
+               n = nodecopy(n);
+               s_down(ep);
+               do {
+                       delfocus(&ep->focus);
+               } while (rite(&ep->focus));
+               if (!allowed(ep->focus, symbol(n))) {
+                       error(DEL_REM); /* The remains wouldn't fit */
+                       noderelease(n);
+                       return No;
+               }
+               replace(&ep->focus, n);
+               s_up(ep);
+               s_down(ep); /* I.e., to leftmost sibling */
+               ep->mode = WHOLE;
+               return Yes;
+       }
+       sym = symbol(n);
+       if (sym == Optional || sym == Hole) {
+               delfocus(&ep->focus);
+               ep->mode = WHOLE;
+       }
+       else if (!allowed(ep->focus, sym)) {
+               preptoqueue(n, &q);
+               delfocus(&ep->focus);
+               ep->mode = WHOLE;
+               return app_queue(ep, &q);
+       }
+       else {
+               replace(&ep->focus, nodecopy(n));
+               ep->mode = ATBEGIN;
+       }
+       return Yes;
+}
+
+
+/*
+ * Delete the focus if ep->mode == WHOLE.
+ */
+
+Hidden bool
+delwhole(ep)
+       register environ *ep;
+{
+       register int sym = symbol(tree(ep->focus));
+
+       Assert(ep->mode == WHOLE);
+       if (sym == Optional || sym == Hole)
+               return No;
+       delfocus(&ep->focus);
+       return Yes;
+}
+
+
+/*
+ * Delete the focus if it is only a hole.
+ * Assume shrink() has been called before!
+ */
+
+Hidden bool
+delhole(ep)
+       register environ *ep;
+{
+       node n;
+       int sym;
+       bool flag = No;
+
+       switch (ep->mode) {
+       
+       case ATBEGIN:
+       case VHOLE:
+       case FHOLE:
+       case ATEND:
+               return widen(ep);
+
+       case WHOLE:
+               Assert((sym = symbol(tree(ep->focus))) == Optional || sym == Hole);
+               if (ichild(ep->focus) != 1)
+                       break;
+               if (!up(&ep->focus))
+                       return No;
+               higher(ep);
+               ep->mode = SUBSET;
+               ep->s1 = 2;
+               ep->s2 = 2;
+               if (fwidth(noderepr(tree(ep->focus))[0]) < 0) {
+                       flag = Yes;
+                       ep->s2 = 3; /* Extend to rest of line */
+               }
+       }
+
+       ep->changed = Yes;
+       grow(ep);
+
+       switch (ep->mode) {
+
+       case SUBSET:
+               if (!delsubset(ep, No))
+                       return No;
+               if (!flag)
+                       return widen(ep);
+               leftvhole(ep);
+               oneline(ep);
+               return Yes;
+
+       case SUBLIST:
+               n = tree(ep->focus);
+               n = lastchild(n);
+               sym = symbol(n);
+               if (!allowed(ep->focus, sym)) {
+                       error(DEL_REM); /* The remains wouldn't fit */
+                       return No;
+               }
+               flag = samelevel(sym, symbol(tree(ep->focus)));
+               replace(&ep->focus, nodecopy(n));
+               if (flag) {
+                       ep->mode = SUBLIST;
+                       ep->s3 = 1;
+               }
+               else
+                       ep->mode = WHOLE;
+               return Yes;
+
+       case WHOLE:
+               Assert(!parent(ep->focus)); /* Must be at root! */
+               return No;
+
+       default:
+               Abort();
+               /* NOTREACHED */
+
+       }
+}
+
+
+/*
+ * Subroutine to delete the focus.
+ */
+
+Visible Procedure
+delfocus(pp)
+       register path *pp;
+{
+       register path pa = parent(*pp);
+       register int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
+
+       replace(pp, child(gram(sympa), ichild(*pp)));
+}
+
+
+/*
+ * Copy command -- copy the focus to the copy buffer if it contains
+ * some text, copy the copy buffer into the focus if the focus is
+ * empty (just a hole).
+ */
+
+Visible bool
+copyinout(ep)
+       register environ *ep;
+{
+       shrink(ep);
+       if (!ishole(ep)) {
+               release(ep->copybuffer);
+               ep->copybuffer = copyout(ep);
+               ep->copyflag = !!ep->copybuffer;
+               return ep->copyflag;
+       }
+       else {
+               fixit(ep); /* Make sure it looks like a hole now */
+               if (!copyin(ep, (queue) ep->copybuffer))
+                       return No;
+               ep->copyflag = No;
+               return Yes;
+       }
+}
+
+
+/*
+ * Copy the focus to the copy buffer.
+ */
+
+Visible value
+copyout(ep)
+       register environ *ep;
+{
+       auto queue q = Qnil;
+       auto path p;
+       register node n;
+       register value v;
+       char buf[15];
+       register string *rp;
+       register int i;
+
+       switch (ep->mode) {
+       case WHOLE:
+               preptoqueue(tree(ep->focus), &q);
+               break;
+       case SUBLIST:
+               p = pathcopy(ep->focus);
+               for (i = ep->s3; i > 0; --i)
+                       downrite(&p) || Abort();
+               for (i = ep->s3; i > 0; --i) {
+                       up(&p) || Abort();
+                       n = tree(p);
+                       subsettoqueue(n, 1, 2*nchildren(n) - 1, &q);
+               }
+               pathrelease(p);
+               break;
+       case SUBSET:
+               balance(ep);
+               subsettoqueue(tree(ep->focus), ep->s1, ep->s2, &q);
+               break;
+       case SUBRANGE:
+               Assert(ep->s3 >= ep->s2);
+               if (ep->s1&1) { /* Fixed text */
+                       Assert(ep->s3 - ep->s2 + 1 < sizeof buf);
+                       rp = noderepr(tree(ep->focus));
+                       Assert(ep->s2 < Fwidth(rp[ep->s1/2]));
+                       strncpy(buf, rp[ep->s1/2] + ep->s2, ep->s3 - ep->s2 + 1);
+                       buf[ep->s3 - ep->s2 + 1] = 0;
+                       stringtoqueue(buf, &q);
+               }
+               else { /* Varying text */
+                       v = (value) child(tree(ep->focus), ep->s1/2);
+                       Assert(Type(v) == Tex);
+                       v = trim(v, ep->s2, Length(v) - ep->s3 - 1);
+                       preptoqueue((node)v, &q);
+                       release(v);
+               }
+               break;
+       default:
+               Abort();
+       }
+       nonewline(&q);
+       return (value)q;
+}
+
+
+/*
+ * Subroutine to ensure the copy buffer doesn't start with a newline.
+ */
+
+Hidden Procedure
+nonewline(pq)
+       register queue *pq;
+{
+       register node n;
+       register int c;
+
+       if (!emptyqueue(*pq)) {
+               for (;;) {
+                       n = queuebehead(pq);
+                       if (Type(n) == Tex) {
+                               if (Str((value) n)[0] != '\n')
+                                       preptoqueue(n, pq);
+                               noderelease(n);
+                               break;
+                       }
+                       else {
+                               c = nodechar(n);
+                               if (c != '\n')
+                                       preptoqueue(n, pq);
+                               else
+                                       splitnode(n, pq);
+                               noderelease(n);
+                               if (c != '\n')
+                                       break;
+                       }
+               }
+       }
+}
+
+
+/*
+ * Refinement for copyout, case SUBSET: make sure that \t is balanced with \b.
+ * Actually it can only handle the case where a \t is in the subset and the
+ * matching \b is immediately following.
+ */
+
+Hidden Procedure
+balance(ep)
+       environ *ep;
+{
+       string *rp = noderepr(tree(ep->focus));
+       int i;
+       int level = 0;
+
+       Assert(ep->mode == SUBSET);
+       for (i = ep->s1/2; i*2 < ep->s2; ++i) {
+               if (rp[i]) {
+                       if (index(rp[i], '\t'))
+                               ++level;
+                       else if (index(rp[i], '\b'))
+                               --level;
+               }
+       }
+       if (level > 0 && i*2 == ep->s2 && rp[i] && index(rp[i], '\b'))
+               ep->s2 = 2*i + 1;
+}
+
+
+/*
+ * Copy the copy buffer to the focus.
+ */
+
+Hidden bool
+copyin(ep, q)
+       register environ *ep;
+       /*auto*/ queue q;
+{
+       auto queue q2 = Qnil;
+
+       if (!q) {
+               error(COPY_EMPTY); /* Empty copy buffer */
+               return No;
+       }
+       ep->changed = Yes;
+       q = qcopy(q);
+       if (!ins_queue(ep, &q, &q2)) {
+               qrelease(q2);
+               return No;
+       }
+       return app_queue(ep, &q2);
+}
+
+
+/*
+ * Find out whether the focus looks like a hole or if it has some real
+ * text in it.
+ * Assumes shrink(ep) has already been performed.
+ */
+
+Visible bool
+ishole(ep)
+       register environ *ep;
+{
+       register int sym;
+
+       switch (ep->mode) {
+       
+       case ATBEGIN:
+       case ATEND:
+       case VHOLE:
+       case FHOLE:
+               return Yes;
+
+       case SUBLIST:
+       case SUBRANGE:
+               return No;
+
+       case SUBSET:
+               return colonhack(ep); /* (Side-effect!) */
+
+       case WHOLE:
+               sym = symbol(tree(ep->focus));
+               return sym == Optional || sym == Hole;
+
+       default:
+               Abort();
+               /* NOTREACHED */
+       }
+}
+
+
+/*
+ * Amendment to ishole so that it categorizes '?: ?' as a hole.
+ * This makes deletion of empty refinements / alternative-suites
+ * easier (Steven).
+ */
+
+Hidden bool
+colonhack(ep)
+       environ *ep;
+{
+       node n = tree(ep->focus);
+       node n1;
+       string *rp = noderepr(n);
+       int i;
+       int sym;
+
+       for (i = ep->s1; i <= ep->s2; ++i) {
+               if (i&1) {
+                       if (!allright(rp[i/2]))
+                               return No;
+               }
+               else {
+                       n1 = child(n, i/2);
+                       if (Type(n1) == Tex)
+                               return No;
+                       sym = symbol(n1);
+                       if (sym != Hole && sym != Optional)
+                               return No;
+               }
+       }
+       return Yes;
+}
+
+
+/*
+ * Refinement for colonhack.  Recognize strings that are almost blank
+ * (i.e. containing only spaces, colons and the allowed control characters).
+ */
+
+Hidden bool
+allright(repr)
+       string repr;
+{
+       if (repr) {
+               for (; *repr; ++repr) {
+                       if (!index(": \t\b\n\r", *repr))
+                               return No;
+               }
+       }
+       return Yes;
+}
diff --git a/usr/contrib/B/src/bed/demo.c b/usr/contrib/B/src/bed/demo.c
new file mode 100644 (file)
index 0000000..e4c030d
--- /dev/null
@@ -0,0 +1,830 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: demo.c,v 2.6 85/08/22 16:01:21 timo Exp $";
+
+/*
+ * B editor -- Editor command processor.
+ */
+
+#include <ctype.h>
+
+#include "b.h"
+#include "feat.h"
+#include "erro.h"
+#include "bobj.h"
+#include "node.h"
+#include "gram.h"
+#include "keys.h"
+#include "supr.h"
+
+#ifdef BTOP
+#include <setjmp.h>
+
+#ifndef CMDPROMPT
+#define CMDPROMPT ">>> " /* Prompt user for immediate command */
+#endif CMDPROMPT
+#endif BTOP
+
+
+value editqueue();
+
+/* Command line flags */
+extern bool dflag;
+extern bool slowterminal;
+
+#ifdef SAVEBUF
+extern char copysavefile[];
+#endif SAVEBUF
+
+
+Visible bool lefttorite;
+       /* Saves some time in nosuggtoqueue() for read from file */
+
+#define MAXHIST 101 /* One more than the number of UNDO's allowed. */
+
+#define Mod(k) (((k)+MAXHIST) % MAXHIST)
+#define Succ(k) (((k)+1) % MAXHIST)
+#define Pred(k) (((k)+MAXHIST-1) % MAXHIST)
+
+Hidden environ *tobesaved;
+Hidden string savewhere;
+
+
+#ifdef BTOP
+
+extern jmp_buf jumpback;
+extern bool interrupted;
+extern bool canjump;
+
+/*
+ * Main loop, called from main program if -t option present.
+ */
+
+Visible Procedure
+mainloop()
+{
+       environ env;
+       environ *ep = &env;
+       FILE *pdown;
+       FILE *pup;
+       int cmdchar;
+
+       savewhere = (string)NULL;
+       tobesaved = (environ*)NULL;
+       start_b(&pdown, &pup);
+       clrenv(ep);
+#ifdef SAVEBUF
+       ep->copybuffer = editqueue(copysavefile);
+       if (ep->copybuffer)
+               ep->copyflag = Yes;
+#endif SAVEBUF
+
+       for (;;) {
+               cmdchar = sleur();
+               if (cmdchar == EOF)
+                       break;
+               getinput(ep, cmdchar, pdown, pup);
+       }
+#ifdef SAVEBUF
+       if (ep->copyflag)
+               savequeue(ep->copybuffer, copysavefile);
+       else
+               savequeue(Vnil, copysavefile);
+#endif SAVEBUF
+       Erelease(*ep);
+}
+
+
+/*
+ * Provide input for the interpreter.
+ */
+
+Hidden Procedure
+getinput(ep, cmdchar, pdown, pup)
+       environ *ep;
+       int cmdchar;
+       FILE *pdown;
+       FILE *pup;
+{
+       int n;
+       char buffer[100];
+       char filename[100];
+       int lineno;
+
+
+       switch (cmdchar) {
+
+       case '>': /* Immediate command */
+       case 'E': /* Expression */
+       case 'R': /* Raw input */
+       case 'Y': /* Yes/No */
+               if (cmdchar == '>')
+                       setroot("Imm_cmd");
+               else if (cmdchar == 'E')
+                       setroot("Expression");
+               else
+                       setroot("Raw_input");
+               delfocus(&ep->focus);
+               initshow();
+               if (cmdchar == '>')
+                       cmdprompt(CMDPROMPT);
+               editdocument(ep);
+               endshow();
+               top(&ep->focus);
+               ep->mode = WHOLE;
+               if (!interrupted)
+                       send(ep->focus, pdown);
+               delete(ep);
+               break;
+
+       case ':':
+       case '=':
+               fgets(buffer, sizeof buffer, pup);
+               if (index(buffer, '+'))
+                       n = sscanf(buffer, " +%d %s", &lineno, filename) - 1;
+               else {
+                       n = sscanf(buffer, " %s", filename);
+                       lineno = 0;
+               }
+               if (n == 1) {
+                       initshow();
+                       dofile(ep, filename, lineno);
+                       endshow();
+                       top(&ep->focus);
+                       ep->mode = WHOLE;
+                       delete(ep);
+                       if (!ep->copyflag) {
+                               release(ep->copybuffer);
+                               ep->copybuffer = Vnil;
+                       }
+               }
+               putc('\n', pdown);
+               interrupted = No; /* Interrupts handled locally in editdocument! */
+               break;
+
+       default:
+               printf("[Unrecognized command character '%c' (0%o)]\n",
+                       cmdchar&0177, cmdchar);
+
+       }
+}
+
+#endif BTOP
+
+
+#ifdef FILEARGS
+
+/*
+ * Edit a single unit or target, called from main program if file name
+ * arguments are present.
+ */
+
+Visible Procedure
+demo(filename, linenumber)
+       string filename;
+       int linenumber;
+{
+       environ env;
+       environ *ep = &env;
+       bool ok;
+
+       clrenv(ep);
+#ifdef SAVEBUF
+       ep->copybuffer = editqueue(copysavefile);
+       if (ep->copybuffer)
+               ep->copyflag = Yes;
+#endif SAVEBUF
+       initshow();
+       ok = dofile(ep, filename, linenumber);
+       endshow();
+       if (!ok)
+               return No;
+#ifdef SAVEBUF
+       if (ep->copyflag)
+               savequeue(ep->copybuffer, copysavefile);
+       else
+               savequeue(Vnil, copysavefile);
+#endif SAVEBUF
+       Erelease(*ep);
+       return Yes;
+}
+
+#endif !FILEARGS
+
+
+/*
+ * Edit a unit or target, using the environment offered as a parameter.
+ */
+
+Hidden bool
+dofile(ep, filename, linenumber)
+       environ *ep;
+       string filename;
+       int linenumber;
+{
+#ifdef HELPFUL
+       static bool didmessage;
+
+       if (!didmessage) {
+               didmessage = Yes;
+               message("[Press ? or ESC-? for help]");
+       }
+#endif HELPFUL
+#ifdef SAVEPOS
+       if (linenumber <= 0)
+               linenumber = getpos(filename);
+#endif SAVEPOS
+       setroot(filename[0] == '=' ? "Target_edit" : "Unit_edit");
+       savewhere = filename;
+       tobesaved = (environ*)NULL;
+
+       lefttorite = Yes;
+       edit(ep, filename, linenumber);
+#ifdef USERSUGG
+       readsugg(ep->focus);
+#endif USERSUGG
+       lefttorite = No;
+
+       ep->generation = 0;
+       if (!editdocument(ep))
+               return No;
+       if (ep->generation > 0) {
+               if (!save(ep->focus, filename))
+                       error("Cannot save unit: %s", unixerror(filename));
+#ifdef USERSUGG
+               writesugg(ep->focus);
+#endif USERSUGG
+       }
+#ifdef SAVEPOS
+       savepos(filename, lineno(ep)+1);
+#endif SAVEPOS
+       savewhere = (char*)NULL;
+       tobesaved = (environ*)NULL;
+       return Yes;
+}
+
+
+/*
+ * Call the editor for a given document.
+ */
+
+Hidden bool
+editdocument(ep)
+       environ *ep;
+{
+       int k;
+       int first = 0;
+       int last = 0;
+       int current = 0;
+       int onscreen = -1;
+       bool reverse = No;
+       environ newenv;
+       int cmd;
+       bool errors = No;
+       int undoage = 0;
+       bool done = No;
+       environ history[MAXHIST];
+
+       Ecopy(*ep, history[0]);
+
+       for (;;) { /* Command interpretation loop */
+               if (onscreen != current)
+                       virtupdate(onscreen < 0 ? (environ*)NULL : &history[onscreen],
+                               &history[current],
+                               reverse && onscreen >= 0 ?
+                                       history[onscreen].highest : history[current].highest);
+               onscreen = current;
+               if (done)
+                       break;
+#ifdef BTOP
+               if (!interrupted && !moreinput())
+#else BTOP
+               if (!moreinput())
+#endif BTOP
+                               actupdate(history[current].copyflag ?
+                                               history[current].copybuffer : Vnil,
+#ifdef RECORDING
+                                       history[current].newmacro != Vnil,
+#else !RECORDING
+                                       No,
+#endif !RECORDING
+                                       No);
+#ifdef BTOP
+               if (interrupted || setjmp(jumpback))
+                       break;
+               canjump = Yes;
+#endif BTOP
+               cmd = inchar();
+#ifdef BTOP
+               canjump = No;
+#endif BTOP
+               errors = No;
+
+               switch (cmd) {
+
+#ifndef NDEBUG
+               case Ctl(@): /* Debug exit with variable dump */
+                       tobesaved = (environ*)NULL;
+                       return No;
+#endif NDEBUG
+
+#ifndef SMALLSYS
+               case Ctl(^): /* Debug status message */
+                       dbmess(&history[current]);
+                       errors = Yes; /* Causes clear after new keystroke seen */
+                       continue;
+#endif !SMALLSYS
+
+               case UNDO:
+                       if (current == first)
+                               errors = Yes;
+                       else {
+                               if (onscreen == current)
+                                       reverse = Yes;
+                               current = Pred(current);
+                               undoage = Mod(last-current);
+                       }
+                       break;
+
+               case REDO:
+                       if (current == last)
+                               errors = Yes;
+                       else {
+                               if (current == onscreen)
+                                       reverse = No;
+                               if (history[Succ(current)].generation <
+                                               history[current].generation)
+                                       error(REDO_OLD); /***** Should refuse altogether??? *****/
+                               current = Succ(current);
+                               undoage = Mod(last-current);
+                       }
+                       break;
+
+#ifdef HELPFUL
+               case HELP:
+                       if (help())
+                               onscreen = -1;
+                       break;
+#endif HELPFUL
+
+               case REDRAW:
+                       onscreen = -1;
+                       trmundefined();
+                       break;
+
+               case EOF:
+                       done = Yes;
+                       break;
+
+               default:
+                       Ecopy(history[current], newenv);
+                       newenv.highest = Maxintlet;
+                       newenv.changed = No;
+                       if (cmd != EXIT)
+                               errors = !execute(&newenv, cmd) || !checkep(&newenv);
+                       else
+                               done = Yes;
+                       if (errors) {
+                               switch (cmd) {
+                               case '\r':
+                               case '\n':
+                                       if (newenv.mode == ATEND && !parent(newenv.focus)) {
+                                               errors = !checkep(&newenv);
+                                               if (!errors)
+                                                       done = Yes;
+                                       }
+                                       break;
+#ifdef HELPFUL
+                               case '?':
+                                       if (help())
+                                               onscreen = -1;
+#endif HELPFUL
+                               }
+                       }
+                       if (errors)
+                               Erelease(newenv);
+                       else {
+#ifndef SMALLSYS
+                               if (done)
+                                       done = canexit(&newenv);
+#endif SMALLSYS
+                               if (newenv.changed)
+                                       ++newenv.generation;
+                               last = Succ(last);
+                               current = Succ(current);
+                               if (last == first) {
+                                       /* Array full (always after a while). Discard "oldest". */
+                                       if (current == last
+                                               || undoage < Mod(current-first)) {
+                                               Erelease(history[first]);
+                                               first = Succ(first);
+                                               if (undoage < MAXHIST)
+                                                       ++undoage;
+                                       }
+                                       else {
+                                               last = Pred(last);
+                                               Erelease(history[last]);
+                                       }
+                               }
+                               if (current != last
+                                       && newenv.highest < history[current].highest)
+                                       history[current].highest = newenv.highest;
+                               /* Move entries beyond current one up. */
+                               for (k = last; k != current; k = Pred(k)) {
+                                       if (Pred(k) == onscreen)
+                                               onscreen = k;
+                                       Emove(history[Pred(k)], history[k]);
+                               }
+                               Ecopy(newenv, history[current]);
+                               Erelease(history[current]);
+                       }
+                       break; /* default */
+
+               } /* switch */
+
+               if (errors && cmd != '?') {
+                       if (!slowterminal && isascii(cmd)
+                               && (isprint(cmd) || cmd == ' '))
+                               error(INS_BAD, cmd);
+                       else
+                               error((char*)NULL);
+               }
+               if (savewhere)
+                       tobesaved = &history[current];
+       } /* for (;;) */
+
+       actupdate(Vnil, No, Yes);
+       Erelease(*ep);
+       Ecopy(history[current], *ep);
+       if (savewhere)
+               tobesaved = ep;
+       for (current = first; current != last; current = Succ(current))
+               Erelease(history[current]);
+       Erelease(history[last]);
+       /* endshow(); */
+       return Yes;
+}
+
+
+/*
+ * Execute a command, return success or failure.
+ */
+
+Hidden bool
+execute(ep, cmd)
+       register environ *ep;
+       register int cmd;
+{
+       register bool spflag = ep->spflag;
+       register int i;
+       environ env;
+       char buf[2];
+       register char *cp;
+#ifdef USERSUGG
+       bool sugg = symbol(tree(ep->focus)) == Suggestion;
+#define ACCSUGG(ep) if (sugg) accsugg(ep)
+#define KILLSUGG(ep) if (sugg) killsugg(ep)
+#else !USERSUGG
+#define ACCSUGG(ep) /* NULL */
+#define KILLSUGG(ep) /* NULL */
+#endif !USERSUGG
+
+#ifdef RECORDING
+       if (ep->newmacro && cmd != USEMACRO && cmd != SAVEMACRO) {
+               buf[0] = cmd;
+               buf[1] = 0;
+               concato(&ep->newmacro, buf);
+       }
+#endif RECORDING
+       ep->spflag = No;
+
+       switch (cmd) {
+
+#ifdef RECORDING
+       case SAVEMACRO:
+               ep->spflag = spflag;
+               if (ep->newmacro) { /* End definition */
+                       release(ep->oldmacro);
+                       if (ep->newmacro && Length(ep->newmacro) > 0) {
+                               ep->oldmacro = ep->newmacro;
+                               message(REC_OK);
+                       }
+                       else {
+                               release(ep->newmacro);
+                               ep->oldmacro = Vnil;
+                       }
+                       ep->newmacro = Vnil;
+               }
+               else /* Start definition */
+                       ep->newmacro = mk_text("");
+               return Yes;
+
+       case USEMACRO:
+               if (!ep->oldmacro || Length(ep->oldmacro) <= 0) {
+                       error(PLB_NOK);
+                       return No;
+               }
+               ep->spflag = spflag;
+               cp = Str(ep->oldmacro);
+               for (i = 0; i < Length(ep->oldmacro); ++i) {
+                       Ecopy(*ep, env);
+                       if (execute(ep, cp[i]&0377) && checkep(ep))
+                               Erelease(env);
+                       else {
+                               Erelease(*ep);
+                               Emove(env, *ep);
+                               if (!i)
+                                       return No;
+                               error((char*)NULL); /* Just a bell */
+                               /* The error must be signalled here, because the overall
+                                  command (USEMACRO) succeeds, so the main loop
+                                  doesn't ring the bell; but we want to inform the
+                                  that not everything was done either. */
+                               return Yes;
+                       }
+               }
+               return Yes;
+#endif RECORDING
+
+#ifndef SMALLSYS
+       case Ctl(_): /* 'Touch', i.e. set modified flag */
+               ep->changed = Yes;
+               return Yes;
+#endif SMALLSYS
+
+       case GOTO:
+               ACCSUGG(ep);
+#ifdef RECORDING
+               if (ep->newmacro) {
+                       error(GOTO_REC);
+                       return No;
+               }
+#endif RECORDING
+               return gotocursor(ep);
+
+       case NEXT:
+               ACCSUGG(ep);
+               return next(ep);
+
+       case PREVIOUS:
+               ACCSUGG(ep);
+               return previous(ep);
+
+       case LEFTARROW:
+               ACCSUGG(ep);
+               return leftarrow(ep);
+
+       case RITEARROW:
+               ACCSUGG(ep);
+               return ritearrow(ep);
+
+       case WIDEN:
+               ACCSUGG(ep);
+               return widen(ep);
+
+       case EXTEND:
+               ACCSUGG(ep);
+               return extend(ep);
+
+       case NARROW:
+               ACCSUGG(ep);
+               return narrow(ep);
+
+       case RNARROW:
+               ACCSUGG(ep);
+               return rnarrow(ep);
+
+       case UPARROW:
+               ACCSUGG(ep);
+               return uparrow(ep);
+
+       case DOWNARROW:
+               ACCSUGG(ep);
+               return downarrow(ep);
+
+       case UPLINE:
+               ACCSUGG(ep);
+               return upline(ep);
+
+       case DOWNLINE:
+               ACCSUGG(ep);
+               return downline(ep);
+
+       case COPY:
+               ACCSUGG(ep);
+               ep->spflag = spflag;
+               return copyinout(ep);
+
+       case DELETE:
+               ACCSUGG(ep);
+               return delete(ep);
+
+       case ACCEPT:
+               ACCSUGG(ep);
+               return accept(ep);
+
+       default:
+               if (!isascii(cmd) || !isprint(cmd))
+                       return No;
+               ep->spflag = spflag;
+               return ins_char(ep, cmd, islower(cmd) ? toupper(cmd) : -1);
+
+       case ' ':
+               ep->spflag = spflag;
+               return ins_char(ep, ' ', -1);
+
+       case RETURN:
+       case NEWLINE:
+               KILLSUGG(ep);
+               return ins_newline(ep);
+       }
+}
+
+
+/*
+ * Initialize an environment variable.  Most things are set to 0 or NULL.
+ */
+
+Hidden Procedure
+clrenv(ep)
+       environ *ep;
+{
+       ep->focus = newpath(Pnil, gram(Optional), 1);
+       ep->mode = WHOLE;
+       ep->copyflag = ep->spflag = ep->changed = No;
+       ep->s1 = ep->s2 = ep->s3 = 0;
+       ep->highest = Maxintlet;
+       ep->copybuffer = Vnil;
+#ifdef RECORDING
+       ep->oldmacro = ep->newmacro = Vnil;
+#endif RECORDING
+       ep->generation = 0;
+       ep->changed = No;
+}
+
+
+/*
+ * Save parse tree and copy buffer.
+ */
+
+Visible Procedure
+enddemo()
+{
+       register environ *ep = tobesaved;
+
+       tobesaved = (environ*)NULL;
+               /* To avoid loops if saving is interrupted. */
+       if (savewhere && ep) {
+               if (ep->generation > 0) {
+                       save(ep->focus, savewhere);
+#ifdef USERSUGG
+                       writesugg(ep->focus);
+#endif USERSUGG
+               }
+#ifdef SAVEBUF
+               if (ep->copyflag)
+                       savequeue(ep->copybuffer, copysavefile);
+               else
+                       savequeue(Vnil, copysavefile);
+#endif SAVEBUF
+#ifdef SAVEPOS
+               savepos(savewhere, lineno(ep)+1);
+#endif SAVEPOS
+       }
+#ifdef BTOP
+       waitchild();
+#endif BTOP
+}
+
+
+/*
+ * Find out if the current position is higher in the tree
+ * than `ever' before (as remembered in ep->highest).
+ * The algorithm of pathlength() is repeated here to gain
+ * some efficiency by stopping as soon as it is clear
+ * no change can occur.
+ * (Higher() is called VERY often, so this pays).
+ */
+
+Visible Procedure
+higher(ep)
+       register environ *ep;
+{
+       register path p = ep->focus;
+       register int pl = 0;
+       register int max = ep->highest;
+
+       while (p) {
+               ++pl;
+               if (pl >= max)
+                       return;
+               p = parent(p);
+       }
+       ep->highest = pl;
+}
+
+
+/*
+ * Issue debug status message.
+ */
+
+Visible Procedure
+dbmess(ep)
+       register environ *ep;
+{
+#ifndef SMALLSYS
+       char stuff[80];
+       register string str = stuff;
+
+       switch (ep->mode) {
+       case VHOLE:
+               sprintf(stuff, "VHOLE:%d.%d", ep->s1, ep->s2);
+               break;
+       case FHOLE:
+               sprintf(stuff, "FHOLE:%d.%d", ep->s1, ep->s2);
+               break;
+       case ATBEGIN:
+               str = "ATBEGIN";
+               break;
+       case ATEND:
+               str = "ATEND";
+               break;
+       case WHOLE:
+               str = "WHOLE";
+               break;
+       case SUBRANGE:
+               sprintf(stuff, "SUBRANGE:%d.%d-%d", ep->s1, ep->s2, ep->s3);
+               break;
+       case SUBSET:
+               sprintf(stuff, "SUBSET:%d-%d", ep->s1, ep->s2);
+               break;
+       case SUBLIST:
+               sprintf(stuff, "SUBLIST...%d", ep->s3);
+               break;
+       default:
+               sprintf(stuff, "UNKNOWN:%d,%d,%d,%d",
+                       ep->mode, ep->s1, ep->s2, ep->s3);
+       }
+       message(
+#ifdef SAVEBUF
+               "%s, %s, wi=%d, hi=%d, (y,x,l)=(%d,%d,%d) %s",
+               symname(symbol(tree(ep->focus))),
+#else !SAVEBUF
+               "%d, %s, wi=%d, hi=%d, (y,x,l)=(%d,%d,%d) %s",
+               symbol(tree(ep->focus)),
+#endif SAVEBUF
+               str, width(tree(ep->focus)), ep->highest,
+               Ycoord(ep->focus), Xcoord(ep->focus), Level(ep->focus),
+                       ep->spflag ? "spflag on" : "");
+#endif !SMALLSYS
+}
+
+#ifndef SMALLSYS
+
+Hidden bool
+canexit(ep)
+       environ *ep;
+{
+       environ env;
+
+       shrink(ep);
+       if (ishole(ep))
+               delete(ep);
+       Ecopy(*ep, env);
+       top(&ep->focus);
+       higher(ep);
+       ep->mode = WHOLE;
+       if (findhole(&ep->focus)) {
+               Erelease(env);
+               error(EXIT_HOLES); /* There are holes left */
+               return No;
+       }
+       Erelease(*ep);
+       Emove(env, *ep);
+       return Yes;
+}
+
+
+Hidden bool
+findhole(pp)
+       register path *pp;
+{
+       register node n = tree(*pp);
+
+       if (Type(n) == Tex)
+               return No;
+       if (symbol(n) == Hole)
+               return Yes;
+       if (!down(pp))
+               return No;
+       for (;;) {
+               if (findhole(pp))
+                       return Yes;
+               if (!rite(pp))
+                       break;
+
+       }
+       up(pp) || Abort();
+       return No;
+}
+
+#endif !SMALLSYS
diff --git a/usr/contrib/B/src/bed/edit.c b/usr/contrib/B/src/bed/edit.c
new file mode 100644 (file)
index 0000000..25048a6
--- /dev/null
@@ -0,0 +1,382 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: edit.c,v 2.5 85/08/22 16:01:43 timo Exp $";
+
+/*
+ * B editor -- Read unit from file.
+ */
+
+#include <ctype.h>
+
+#include "b.h"
+#include "feat.h"
+#include "erro.h"
+#include "bobj.h"
+#include "node.h"
+#include "tabl.h"
+#include "gram.h"
+#include "supr.h"
+#include "queu.h"
+
+string unixerror();
+
+/*
+ * TABSIZE sets the number of spaces equivalent to a tab character
+ * read from the input; INDENT sets the number of spaces for one indentation
+ * level.
+ * The definitions here are unrelated to the definition of TABS
+ * in eval.h (used by show.c and eval.c).  The definition here only
+ * defines how many spaces must be equivalenced to a tab stop when read
+ * from a file; tab stops must be caused by editing a unit with another
+ * editor (vi, ed, ex, emacs), since "save.c" always writes spaces,
+ * not tabs.  The value '4' is best suited for people at the CWI who
+ * may have workspaces with units edited with the previous version of
+ * the B editor, which emitted a tab for each indentation level (and
+ * assumed 4 spaces for a tab stop on input).
+ *
+ * The variables 'spacesused' and 'tabsused' are kept to see if mixed use
+ * of spaces and tabs was made; this can cause indentation errors.
+ */
+
+#ifdef CWI
+#define TABSIZE 4
+#else
+#define TABSIZE 8
+#endif
+
+#define INDENT 4
+
+Hidden bool spacesused;
+Hidden bool tabsused;
+
+
+/*
+ * Read (edit) parse tree from file into the focus.
+ * Rather ad hoc, we use ins_string for each line
+ * and do some magic tricks to get the indentation right
+ * (most of the time).
+ * If line > 0, position the focus at that line, if possible;
+ * otherwise the focus is left at the end of the inserted text.
+ */
+
+Visible bool
+edit(ep, filename, line)
+       register environ *ep;
+       string filename;
+       int line;
+{
+       int lines = 0;
+       register FILE *fp = fopen(filename, "r");
+       register int c;
+       char buf[BUFSIZ];
+       auto string cp;
+       auto queue q = Qnil;
+
+       if (!fp) {
+               error("%s", unixerror(filename));
+               return No;
+       }
+
+       spacesused = tabsused = No;
+       do {
+               do {
+                       for (cp = buf; cp < buf + sizeof buf - 1; ++cp) {
+                               c = getc(fp);
+                               if (c == EOF || c == '\n')
+                                       break;
+                               if (c < ' ' || c >= 0177)
+                                       c = ' ';
+                               *cp = c;
+                       }
+                       if (cp > buf) {
+                               *cp = 0;
+                               if (!ins_string(ep, buf, &q, 0) || !emptyqueue(q)) {
+                                       qrelease(q);
+                                       error(EDIT_BAD);
+                                       fclose(fp);
+                                       return No;
+                               }
+                               qrelease(q);
+                       }
+               } while (c != EOF && c != '\n');
+               ++lines;
+               if (c != EOF && !editindentation(ep, fp)) {
+                       fclose(fp);
+                       return No;
+               }
+       } while (c != EOF);
+       fclose(fp);
+       if (ep->mode == FHOLE || ep->mode == VHOLE && (ep->s1&1)) {
+               cp = "";
+               soften(ep, &cp, 0);
+       }
+       if (lines > 1 && line > 0) {
+               gotoyx(ep, line-1, 0);
+               oneline(ep);
+       }
+       if (spacesused && tabsused)
+               error(EDIT_TABS);
+       return Yes;
+}
+
+
+/*
+ * Do all the footwork required to get the indentation proper.
+ */
+
+Hidden Procedure
+editindentation(ep, fp)
+       register environ *ep;
+       register FILE *fp;
+{
+       register int tabs = 0;
+       auto int level;
+       register int c;
+
+       while ((c = getc(fp)) == ' ' || c == '\t') {
+               if (c == ' ') {
+                       spacesused = Yes;
+                       ++tabs;
+               }
+               else {
+                       tabsused = Yes;
+                       tabs = (tabs/TABSIZE + 1)*TABSIZE;
+               }
+       }
+       ungetc(c, fp);
+       if (c == EOF || c == '\n')
+               return Yes;
+       tabs = (tabs+(INDENT/2))/INDENT; /* Transform to tab stops */
+       if (!ins_newline(ep)) {
+#ifndef NDEBUG
+               debug("[Burp! Can't insert a newline.]");
+#endif NDEBUG
+               return No;
+       }
+       level = Level(ep->focus);
+       for (; tabs < level; --level) {
+               if (!ins_newline(ep)) {
+#ifndef NDEBUG
+                       debug("[Burp, burp! Can't decrease indentation.]");
+#endif NDEBUG
+                       return No;
+               }
+       }
+       fixit(ep);
+       return Yes;
+}
+
+
+/* ------------------------------------------------------------ */
+
+#ifdef SAVEBUF
+
+/*
+ * Read the next non-space character.
+ */
+
+Hidden int
+skipsp(fp)
+       register FILE *fp;
+{
+       register int c;
+
+       do {
+               c = getc(fp);
+       } while (c == ' ');
+       return c;
+}
+
+
+/*
+ * Read a text in standard B format when the initial quote has already
+ * been read.
+ */
+
+Hidden value
+readtext(fp, quote)
+       register FILE *fp;
+       register char quote;
+{
+       auto value v = Vnil;
+       char buf[BUFSIZ];
+       register string cp = buf;
+       register int c;
+       auto int i;
+
+       for (; ; ++cp) {
+               c = getc(fp);
+               if (!isascii(c) || c != ' ' && !isprint(c)) {
+                       if (c == EOF)
+                               debug("readtext: EOF");
+                       else
+                               debug("readtext: bad char (0%02o)", c);
+                       release(v);
+                       return Vnil; /* Bad character or EOF */
+               }
+               if (c == quote) {
+                       c = getc(fp);
+                       if (c != quote) {
+                               ungetc(c, fp);
+                               break;
+                       }
+               }
+               else if (c == '`') {
+                       c = skipsp(fp);
+                       if (c == '$') {
+                               i = 0;
+                               if (fscanf(fp, "%d", &i) != 1
+                                       || i == 0 || !isascii(i)) {
+                                       debug("readtext: error in conversion");
+                                       release(v);
+                                       return Vnil;
+                               }
+                               c = skipsp(fp);
+                       }
+                       else
+                               i = '`';
+                       if (c != '`') {
+                               if (c == EOF)
+                                       debug("readtext: EOF in conversion");
+                               else
+                                       debug("readtext: bad char in conversion (0%o)", c);
+                               release(v);
+                               return Vnil;
+                       }
+                       c = i;
+               }
+               if (cp >= &buf[sizeof buf - 1]) {
+                       *cp = 0;
+                       if (v)
+                               concato(&v, buf);
+                       else
+                               v = mk_text(buf);
+                       cp = buf;
+               }
+               *cp = c;
+       }
+       *cp = 0;
+       if (!v)
+               return mk_text(buf);
+       concato(&v, buf);
+       return v;
+}
+
+
+Hidden int
+readsym(fp)
+       register FILE *fp;
+{
+       register int c;
+       char buf[100];
+       register string bufp;
+
+       for (bufp = buf; ; ++bufp) {
+               c = getc(fp);
+               if (c == EOF)
+                       return -1;
+               if (!isascii(c) || !isalnum(c) && c != '_') {
+                       if (ungetc(c, fp) == EOF)
+                               syserr("readsym: ungetc failed");
+                       break;
+               }
+               *bufp = c;
+       }
+       *bufp = 0;
+       if (isdigit(buf[0]))
+               return atoi(buf);
+       if (strcmp(buf, "Required") == 0) /***** Compatibility hack *****/
+               return Hole;
+       return nametosym(buf);
+}
+
+
+/*
+ * Read a node in internal format (recursively).
+ * Return nil pointer if EOF or error.
+ */
+
+Hidden node
+readnode(fp)
+       FILE *fp;
+{
+       int c;
+       int nch;
+       node ch[MAXCHILD];
+       node n;
+       int sym;
+
+       c = skipsp(fp);
+       switch (c) {
+       case EOF:
+               return Nnil; /* EOF hit */
+
+       case '(':
+               sym = readsym(fp);
+               if (sym < 0) {
+                       debug("readnode: missing symbol");
+                       return Nnil; /* No number as first item */
+               }
+               if (sym < 0 || sym > Hole) {
+                       debug("readnode: bad symbol (%d)", sym);
+                       return Nnil;
+               }
+               nch = 0;
+               while ((c = skipsp(fp)) == ',' && nch < MAXCHILD) {
+                       n = readnode(fp);
+                       if (!n) {
+                               for (; nch > 0; --nch)
+                                       noderelease(ch[nch-1]);
+                               return Nnil; /* Error encountered in child */
+                       }
+                       ch[nch] = n;
+                       ++nch;
+               }
+               if (c != ')') {
+                       if (c == ',')
+                               debug("readnode: node too long (sym=%d)", sym);
+                       else
+                               debug("readnode: no ')' where expected (sym=%d)", sym);
+                       for (; nch > 0; --nch)
+                               noderelease(ch[nch-1]);
+                       return Nnil; /* Not terminated with ')' or too many children */
+               }
+               if (nch == 0)
+                       return gram(sym); /* Saves space for Optional/Hole nodes */
+               return newnode(nch, sym, ch);
+
+       case '\'':
+       case '"':
+               return (node) readtext(fp, c);
+
+       default:
+               debug("readnode: bad initial character");
+               return Nnil; /* Bad initial character */
+       }
+}
+
+
+/*
+ * Read a node written in a more or less internal format.
+ */
+
+Visible value
+editqueue(filename)
+       string filename;
+{
+       register FILE *fp = fopen(filename, "r");
+       auto queue q = Qnil;
+       register node n;
+
+       if (!fp)
+               return Vnil;
+       do {
+               n = readnode(fp);
+               if (!n)
+                       break; /* EOF or error */
+               addtoqueue(&q, n);
+               noderelease(n);
+       } while (skipsp(fp) == '\n');
+       fclose(fp);
+       return (value)q;
+}
+#endif SAVEBUF
diff --git a/usr/contrib/B/src/bed/erro.c b/usr/contrib/B/src/bed/erro.c
new file mode 100644 (file)
index 0000000..633cd70
--- /dev/null
@@ -0,0 +1,201 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: erro.c,v 2.5 85/08/22 16:02:02 timo Exp $";
+
+/*
+ * B editor -- Handle error messages.
+ */
+
+#include "b.h"
+#include "feat.h"
+#include "node.h"
+
+
+extern bool hushbaby;
+extern bool dflag;
+
+string querepr();
+
+extern int winheight; /* From scrn.c */
+extern int winstart; /* From scrn.c */
+extern int llength; /* From scrn.c */
+
+#define SOBIT 0200 /* Interface with wind.c */
+
+#define MAXMSG 1000
+
+static char msgbuffer[MAXMSG];
+static bool ringbell;
+static int priority;
+
+
+/*
+ * Status line.  A combination of scroll bar, error message etc.
+ * Put the message on the screen and clear the buffers for next time.
+ * If there is no message, show status and copy buffer and recording mode.
+ */
+
+Visible Procedure
+stsline(totlines, topline, scrlines, copybuffer, recording)
+       int totlines;
+       int topline;
+       int scrlines;
+       value copybuffer;
+       bool recording;
+{
+       register string bp;
+
+       if (ringbell && !hushbaby)
+               trmbell();
+       if (msgbuffer[0]) {
+               msgbuffer[llength-1] = '\0'; /* Truncate */
+               if (ringbell) {
+                       for (bp = msgbuffer; *bp; ++bp)
+                               *bp |= SOBIT;
+               }
+       }
+       else {
+               bp = msgbuffer;
+#ifdef SCROLLBAR
+               bp += addscrollbar(totlines, topline, scrlines);
+#endif SCROLLBAR
+               if (recording) {
+                       strcpy(bp, "[Recording] ");
+                       bp += (sizeof "[Recording] ") - 1;
+               }
+               if (copybuffer) {
+#ifdef SHOWBUF
+                       sprintf(bp, "[Copy buffer: %.80s]",
+                               querepr(copybuffer));
+                       while (*bp)
+                               ++bp;
+                       if (bp >= msgbuffer+80)
+                               strcpy(msgbuffer+75, "...]");
+#else !SHOWBUF
+                       strcpy(bp, "[Copy buffer]");
+#endif !SHOWBUF
+               }
+       }
+       trmputdata(winheight, winheight, 0, msgbuffer);
+       msgbuffer[0] = 0;
+       priority = 0;
+       ringbell = No;
+}
+
+#ifdef SCROLLBAR
+
+/*
+ * Paint a beautiful scroll bar so the user can see about what part of the
+ * unit is visible on the screen (considering logical lines).
+ */
+
+Hidden int
+addscrollbar(totlines, topline, scrlines)
+       int totlines;
+       int topline;
+       int scrlines;
+{
+       int endline;
+       register int i;
+
+       if (winstart > 0 || scrlines > totlines)
+               return 0; /* Nothing outside screen */
+       if (totlines <= 0)
+               totlines = 1; /* Don't want to divide by 0 */
+       topline = topline*winheight / totlines;
+       endline = topline + (scrlines*winheight + totlines-1) / totlines;
+       if (endline > winheight)
+               endline = winheight;
+       if (topline >= endline)
+               topline = endline-1;
+       for (i = 0; i < topline; ++i)
+               msgbuffer[i] = '-';
+       for (; i < endline; ++i)
+               msgbuffer[i] = '#';
+       for (; i < winheight; ++i)
+               msgbuffer[i] = '-';
+       msgbuffer[i++] = ' ';
+       msgbuffer[i] = '\0';
+       return i;
+}
+
+#endif SCROLLBAR
+
+/*
+ * Issue an error message.  These have highest priority.
+ * Once an error message is in the buffer, further error messages are ignored
+ * until it has been displayed.
+ */
+
+/* VARARGS 1 */
+Visible Procedure
+error(fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
+       string fmt;
+{
+       ringbell = Yes;
+       if (fmt && priority < 3) {
+               priority = 3;
+               sprintf(msgbuffer, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10);
+       }
+}
+
+
+/*
+ * Issue an informative message.  These have medium priority.
+ * Unlike error messages, the last such message is displayed.
+ */
+
+/* VARARGS 1 */
+Visible Procedure
+message(fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
+       register string fmt;
+{
+       if (fmt && priority <= 2) {
+               priority = 2;
+               sprintf(msgbuffer, fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10);
+       }
+}
+
+
+/*
+ * Issue a debugging message.  These  have lowest priority and
+ * are not shown to ordinary users.
+ */
+
+/* VARARGS1 */
+Visible Procedure
+debug(fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10)
+       string fmt;
+{
+#ifndef NDEBUG
+       if (fmt && priority <= 1) {
+               priority = 1;
+               sprintf(msgbuffer,
+                       fmt, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10);
+       }
+#endif NDEBUG
+}
+
+
+/*
+ * Dump any error message still remaining to stderr.
+ */
+
+Visible Procedure
+enderro()
+{
+       if (msgbuffer[0]) {
+               fprintf(stderr, "%s\n", msgbuffer);
+       }
+       msgbuffer[0] = 0;
+       priority = 0;
+       ringbell = No;
+}
+
+
+/*
+ * This #define causes "erro.h" to compile a table of error messages.
+ */
+
+#define _ERROR(name, message) char name[] = message
+
+#include "erro.h"
diff --git a/usr/contrib/B/src/bed/erro.h b/usr/contrib/B/src/bed/erro.h
new file mode 100644 (file)
index 0000000..d2998a1
--- /dev/null
@@ -0,0 +1,26 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: erro.h,v 2.2 84/07/11 15:14:16 guido Exp $ */
+
+/*
+ * B editor -- User (error) messages collected together.
+ */
+
+#ifndef _ERROR
+#define _ERROR(name, message) extern char name[]
+#endif
+
+_ERROR(COPY_EMPTY, "Empty copy buffer");
+_ERROR(DEL_REM, "The remains wouldn't fit");
+_ERROR(EDIT_BAD, "Trouble reading your unit, see last line. Hit break if you don't want this");
+_ERROR(EDIT_TABS, "Spaces and tabs mixed for indentation; check your program layout");
+_ERROR(EXIT_HOLES, "There are still holes left.  Please fill or delete these first.");
+_ERROR(GOTO_BAD, "Sorry -- bad reply from terminal for cursor sense");
+_ERROR(GOTO_NO, "Sorry -- your terminal does not support the control-G command");
+_ERROR(GOTO_OUT, "The cursor isn't pointing at a part of the buffer");
+_ERROR(GOTO_REC, "You can't use control-G in recording mode (it wouldn't work in playback)");
+_ERROR(GOTO_TAH, "Type-ahead lost");
+_ERROR(GOTO_TO, "Cursor sense time-out");
+_ERROR(INS_BAD, "Cannot insert '%c'");
+_ERROR(PLB_NOK, "No keystrokes recorded");
+_ERROR(REC_OK, "Keystrokes recorded, use control-P to play back");
+_ERROR(REDO_OLD, "This redo brought you to an older version.  Type backspace to undo");
diff --git a/usr/contrib/B/src/bed/eval.c b/usr/contrib/B/src/bed/eval.c
new file mode 100644 (file)
index 0000000..39a9f50
--- /dev/null
@@ -0,0 +1,180 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+static char rcsid[] = "$Header: eval.c,v 2.3 84/07/19 11:47:18 guido Exp $";
+
+/*
+ * B editor -- Width attribute evaluation.
+ */
+
+#include "b.h"
+#include "node.h"
+#include "gram.h"
+#include "eval.h"
+
+
+/*
+ * The following convention is used throughout the editor to indicate
+ * the sizes of objects.
+ * - A zero or positive `width' value means the object contains no
+ *   linefeeds.  The width is counted in characters.
+ * - A negative `width' means the object (or its children) contains
+ *   at leasty one linefeed (return is treated as a linefeed here).
+ *   The number of linefeeds is -width.
+ *   There is no indication whether the object fits on that number of
+ *   physical lines, as logical lines may have arbitrary length.
+ *
+ * For coordinates the following convention is used.
+ * (Note that, in accordance to the convention in curses(3), the
+ * `y' coordinate always precedes the `x' coorxdinate.)
+ * - `Y' is the line number, counted from the beginning of the unit.
+ *   These are logical lines rather than physical lines.
+ *   The first line has line number 0.
+ * - `X' is the column number.  The first column is 0.  For x < 0,
+ *   see the important notice below.
+ * - `Level' is the indentation level, indicating where a new line
+ *   would start if inserted at the current position.
+ *   The initial `x' position of such a line is `level*TABS'.
+ *
+ * ***** IMPORTANT NOTICE *****
+ * A special case is x = -1.  This means that the current x position is
+ * unknown.  Further output on the same line is suppressed, until a
+ * linefeed is encountered.  This feature is necessary because while
+ * calculating coordinates, when an object has width < 0, only the y
+ * coordinate of the end of that object is known.  In this case, the
+ * next non-empty object MUST START WITH A LINEFEED, or it will not
+ * be visible on the screen (in practice, a space is sometimes present
+ * in the parse tree which is not shown then).
+ */
+
+
+/*
+ * Compute the (y, x) coordinates and indent level just before
+ * the beginning of the j'th child, if the current node starts
+ * at the initial values of (y, x) and level.
+ */
+
+Visible Procedure
+evalcoord(n, jch, py, px, plevel)
+       register node n;
+       register int jch;
+       int *py;
+       int *px;
+       int *plevel;
+{
+       node nn;
+       register int i;
+       register string *rp = noderepr(n);
+       register int k;
+       register int y = 0;
+       int x = *px;
+       int level = *plevel;
+       int nch = Type(n) == Tex ? 0 : nchildren(n);
+
+       if (jch > nch)
+               jch = nch+1;
+       for (i = 0; i < jch; ++i) {
+               if (i) {
+                       nn = child(n, i);
+                       k = width(nn);
+                       if (k < 0) {
+                               y += -k;
+                               x = k;
+                       }
+                       else if (x >= 0)
+                               x += k;
+               }
+               k = Fwidth(rp[i]);
+               if (k < 0) {
+                       y += -k;
+                       x = rp[i][0] == '\r' ? 0 : TABS*level;
+                       x += strlen(rp[i]) - 1;
+               }
+               else {
+                       if (x >= 0)
+                               x += k;
+                       if (rp[i]) {
+                               if (rp[i][k] == '\t')
+                                       ++level;
+                               else if (rp[i][k] == '\b')
+                                       --level;
+                       }
+               }
+       }
+
+       *py += y;
+       *px = x;
+       *plevel = level;
+}
+
+
+/*
+ * Yield the width of a piece of fixed text as found in a node's repr,
+ * excluding \b or \t.  If \n or \r is found, -1 is returned.
+ * It assumes that \n or \r only occur as first
+ * character, and \b or \t only as last.
+ */
+
+Visible int
+fwidth(str)
+       register string str;
+{
+       register int c;
+       register int n = 0;
+
+       if (!str)
+               return 0;
+       c = str[0];
+       if (c == '\r' || c == '\n')
+               return -1;
+       for (; c; c = *++str)
+               ++n;
+       if (n > 0) {
+               c = str[-1];
+               if (c == '\t' || c == '\b')
+                       --n;
+       }
+       return n;
+}
+
+
+/*
+ * Evaluate the width of node n, assuming the widths of its children
+ * have correctly been calculated.
+ */
+
+Visible int
+evalwidth(n)
+       register node n;
+{
+       register int w;
+       register int i;
+       register string *rp;
+       register int y = 0;
+       register int x = 0;
+       register int nch;
+       register node nn;
+
+       rp = noderepr(n);
+       nch = Type(n) == Tex ? 0 : nchildren(n);
+       for (i = 0; i <= nch; ++i) {
+               if (i) {
+                       nn = child(n, i);
+                       w = width(nn);
+                       if (w < 0) {
+                               y += -w;
+                               x = w;
+                       }
+                       else
+                               x += w;
+               }
+               w = Fwidth(rp[i]);
+               if (w < 0) {
+                       y += -w;
+                       x = 0;
+               }
+               else
+                       x += w;
+       }
+       if (y > 0)
+               return -y;
+       return x;
+}
diff --git a/usr/contrib/B/src/bed/eval.h b/usr/contrib/B/src/bed/eval.h
new file mode 100644 (file)
index 0000000..be6b78e
--- /dev/null
@@ -0,0 +1,8 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: eval.h,v 2.0 84/06/18 15:46:48 guido Exp $ */
+
+/*
+ * B editor -- Definition for width attribute evaluation.
+ */
+
+#define TABS 3
diff --git a/usr/contrib/B/src/bed/feat.h b/usr/contrib/B/src/bed/feat.h
new file mode 100644 (file)
index 0000000..fa69b49
--- /dev/null
@@ -0,0 +1,46 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: feat.h,v 2.4 85/08/22 16:02:40 timo Exp $ */
+
+/*
+ * B editor -- #define features, to make it easy to turn them off.
+ */
+
+#define BTOP 1 /* Editor used as front-end to interpreter */
+       /*
+        * (This used to be an optional feature of the editor, but is now
+        * the only officially acknowledged way of using the B system.
+        * Non-UNIX systems may have no choice but to turn it off, because
+        * it heavily depends on features like forks and pipes.
+        */
+
+#ifndef SMALLSYS
+/*
+ * The #define SMALLSYS squeezes out some lesser important debugging
+ * code, while leaving out the following #defines turns off various
+ * features which can be missed (according to the author).
+ * They are roughly sorted on amount of code saved, greatest
+ * saving first.
+ */
+
+#define SAVEBUF 1 /* Save Copy Buffer on file between edit sessions */
+#define USERSUGG 1 /* Give suggestions for user-defined commands */
+#define SAVEPOS 1 /* Save focus position between edit sessions */
+#define FILEARGS 1 /* Allow 'stand-alone' editor to edit single units */
+#define RECORDING 1 /* [record] and [playback] commands */
+#define SCROLLBAR 1 /* Show scroll bar if unit > screen */
+#define SHOWBUF 1 /* Shows contents of copy buffer if locked */
+
+/*
+ * The following feature used to fit, even on a (our) PDP-11/45.
+ * And as it is very useful for novice users, you might try to let it stay.
+ */
+#define HELPFUL 1 /* Print help blurb on ESC-? or ? */
+
+#endif !SMALLSYS
+
+/*
+ * On compilers that implement C according to the Kernighan and Ritchie book,
+ * but not the unix v7 extensions, turn off the following definition.
+ */
+
+#define STRUCTASS 1 /* C compiler knows structure assignment */
diff --git a/usr/contrib/B/src/bed/file.c b/usr/contrib/B/src/bed/file.c
new file mode 100644 (file)
index 0000000..bff5c18
--- /dev/null
@@ -0,0 +1,60 @@
+/* Bed -- file names collected together for easy reference and change. */
+/* $Header: file.c,v 1.1 85/08/22 15:44:30 timo Exp $ */
+
+#include "b.h"
+#include "file.h"
+
+/* These are only defaults -- may be changed from environment */
+
+#ifdef unix
+Visible string tmpdir= "/tmp";
+Visible string homedir= ".";
+Visible string libdir= "/usr/new/lib/B";
+
+Visible string helpfile= "/usr/new/lib/B/Bed_help";
+Visible string posfile= ".Bed_pos"; /* With $HOME prepended */
+Visible string buffile= ".Bed_buf"; /* With $HOME prepended */
+Visible string keyfile= ".Bed_"; /* Some dir prepended, term.type appended */
+Visible string deftype= "def"; /* Default terminal type affix for keyfile */
+#endif unix
+
+#ifdef IBMPC
+Visible string tmpdir= "\\";
+Visible string homedir= "."; /* Can't get home... */
+Visible string libdir= "\\LIB";
+
+Visible string helpfile= "\\LIB\\BED.HLP";
+Visible string posfile= "BED.POS";
+Visible string buffile= "BED.BUF";
+Visible string keyfile= "BED."; /* Some dir prepended, deftype appended */
+Visible string deftype= "KEY"; /* Default terminal type affix for keyfile */
+#endif IBMPC
+
+
+Hidden string setdefault(envname, def)
+       string envname;
+       string def; /* 'default' is a C reserved word! */
+{
+       string envval= getenv(envname);
+       if (envval != NULL && envval[0] != '\0')
+               return envval;
+       return def;
+}
+
+
+Visible initfile()
+{
+       static char copysavefile[200];
+       static char saveposfile[200];
+
+       homedir= setdefault("HOME", homedir);
+       tmpdir= setdefault("TEMPDIR", tmpdir);
+       libdir= setdefault("BED_LIB", libdir);
+
+       sprintf(copysavefile, "%.150s/%.40s", homedir, buffile);
+       sprintf(saveposfile, "%.150s/%.40s", homedir, posfile);
+
+       helpfile= setdefault("BED_HELP", helpfile);
+       posfile= setdefault("BED_POS", saveposfile);
+       buffile= setdefault("BED_BUF", copysavefile);
+}
diff --git a/usr/contrib/B/src/bed/file.h b/usr/contrib/B/src/bed/file.h
new file mode 100644 (file)
index 0000000..bd10397
--- /dev/null
@@ -0,0 +1,18 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
+
+/*
+  $Header: file.h,v 1.1 85/08/22 15:50:06 timo Exp $
+*/
+
+/* Linda -- file names collected together for easy reference and change. */
+
+extern string tmpdir;
+extern string libdir;
+extern string homedir;
+
+extern string helpfile;
+extern string posfile;
+extern string buffile;
+extern string keyfile;
+
+extern string deftype; /* Default terminal type for keyfile */
diff --git a/usr/contrib/B/src/bed/gram.h b/usr/contrib/B/src/bed/gram.h
new file mode 100644 (file)
index 0000000..29a32d4
--- /dev/null
@@ -0,0 +1,42 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: gram.h,v 2.0 84/06/18 15:46:55 guido Exp $ */
+
+/*
+ * B editor -- Grammar symbols.
+ */
+
+/*
+ * Values used in "tabl.c" but also publicly.
+ */
+
+#define Rootsymbol     00
+#define Suggestion     97
+#define Optional       98
+#define Hole           99
+
+
+/*
+ * Ditto for "lexi.c".
+ */
+
+#define LEXICAL 100
+
+/*
+ * Routines defined in "gram.c".
+ */
+
+string *noderepr();
+node gram();
+node suggestion();
+node variable();
+string symname();
+
+/*
+ * Macros for oft-used funtion.
+ */
+
+#define Fwidth(str) ((str) ? fwidth(str) : 0)
+
+#define Fw_zero(str) (!(str) || index("\b\t", (str)[0]))
+#define Fw_positive(str) ((str) && (str)[0] >= ' ')
+#define Fw_negative(str) ((str) && (str)[0] == '\n')
diff --git a/usr/contrib/B/src/bed/keys.h b/usr/contrib/B/src/bed/keys.h
new file mode 100644 (file)
index 0000000..b848974
--- /dev/null
@@ -0,0 +1,66 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: keys.h,v 2.3 85/08/22 16:04:38 timo Exp $ */
+
+/*
+ * B editor -- Function key and control character definitions.
+ */
+
+
+#define Ctl(x) ('x'&037)
+
+/*
+ * Commands bound to control characters.
+ *
+ * Not all control characters can be freely used:
+ * ^Q and ^S are used by the Unix operating system
+ * for output flow control, and ^Z is used by BSD
+ * Unix systems for `job control'.
+ *
+ * Also note that ^H, ^I and ^M (and somtimes ^J) have their
+ * own keys on most keyboards and thus usually have a strong
+ * intuitive meaning.
+ */
+
+#define COPY   Ctl(C)
+#define DELETE Ctl(D)
+#define GOTO   Ctl(G)
+#define UNDO   Ctl(H)
+#define ACCEPT Ctl(I)          /* TAB */
+#define NEWLINE        Ctl(J)
+#define REDRAW Ctl(L)
+#define RETURN Ctl(M)
+#define RECORD Ctl(R)
+#define PLAYBACK       Ctl(P)
+#define USEMACRO       PLAYBACK
+#define SAVEMACRO      RECORD
+#define REDO   Ctl(U)
+#define EXIT   Ctl(X)
+
+
+/*
+ * Commands bound to ESC sequences.
+ *
+ * When 'inchar()' in "getc.c" sees an ESC-x sequence, it
+ * will return (x&0177)|MASK.
+ */
+
+#define MASK 0200 /* Must fit in a character! */
+
+#define WIDEN          ('w'|MASK) /* so "\ew" is recognized as WIDEN */
+#define NARROW         ('f'|MASK) /* FIRST */
+#define RNARROW                ('l'|MASK) /* LAST */
+#define EXTEND         ('e'|MASK)
+
+#define UPLINE         ('u'|MASK)
+#define PREVIOUS       ('p'|MASK)
+#define NEXT           ('n'|MASK)
+#define DOWNLINE       ('d'|MASK)
+
+#define LEFTARROW      (','|MASK)
+#define RITEARROW      ('.'|MASK)
+#define UPARROW                ('U'|MASK)
+#define DOWNARROW      ('D'|MASK)
+
+#ifdef HELPFUL
+#define HELP   ('?'|MASK)
+#endif HELPFUL
diff --git a/usr/contrib/B/src/bed/node.h b/usr/contrib/B/src/bed/node.h
new file mode 100644 (file)
index 0000000..acdfb5a
--- /dev/null
@@ -0,0 +1,153 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: node.h,v 2.4 85/08/22 16:05:40 timo Exp $ */
+
+/*
+ * B editor -- Parse tree and Focus stack.
+ */
+
+/*
+ * Assertion macro.
+ *
+ * This one differs from the one in #include <assert.h> in that it
+ * is usable as an expression operand, e.g. up(ep) || Assert(No).
+ * The function asserr() must unconditionally terminate the program.
+ * If the accumulated __FILE__ data wastes too much of your data
+ * space, omit them and change the code in asserr() that uses them.
+ * You better trust your code then, because unless compiled with "-g"
+ * it's difficult to dig the line number information from the core dump.
+ *
+ * There is also a variant called Abort() which is equivalent to Assert(No).
+ */
+
+#ifdef NDEBUG
+#define Abort() abort() /* Always fail */
+#define Assert(cond) 0 /* Dummy expression */
+#else NDEBUG
+#undef __FILE__
+#define __FILE__ rcsid
+#ifndef __LINE__
+#define __LINE__ 0
+#endif __LINE__
+#define Abort() asserr(__FILE__, __LINE__)
+#define Assert(cond) ((cond) || Abort())
+#endif NDEBUG
+
+typedef struct node *node;
+typedef struct path *path;
+typedef int markbits;
+
+struct node {
+       char    type;
+       char    _unused;
+       intlet  refcnt;
+       intlet  len;
+       markbits        n_marks;
+       intlet  n_width;
+       intlet  n_symbol;
+       node    n_child[1];
+};
+
+struct path {
+       char    type;
+       char    _unused;
+       intlet  refcnt;
+       intlet  len;
+       path    p_parent;
+       node    p_tree;
+       intlet  p_ichild;
+       intlet  p_ycoord;
+       intlet  p_xcoord;
+       intlet  p_level;
+       markbits        p_addmarks;
+       markbits        p_delmarks;
+};
+
+
+#define Nnil ((node) NULL)
+
+node newnode();
+
+#ifndef NDEBUG
+#define symbol(n) (Assert(Type(n)==Nod), (n)->n_symbol)
+#define nchildren(n) (Assert(Type(n)==Nod), Length(n))
+#define marks(n) (Assert(Type(n)==Nod), (n)->n_marks)
+#define child(n, i) \
+       (Assert(Type(n)==Nod && (i)>0 && (i)<=Length(n)), (n)->n_child[(i)-1])
+#define lastchild(n) \
+       (Assert(Type(n)==Nod && Length(n)>0), (n)->n_child[Length(n)-1])
+#define firstchild(n) \
+       (Assert(Type(n)==Nod && Length(n)>0), (n)->n_child[0])
+#else NDEBUG
+#define symbol(n) ((n)->n_symbol)
+#define nchildren(n) (Length(n))
+#define marks(n) ((n)->n_marks)
+#define child(n, i) ((n)->n_child[(i)-1])
+#define lastchild(n) ((n)->n_child[Length(n)-1])
+#define firstchild(n) ((n)->n_child[0])
+#endif NDEBUG
+
+#define width(n) (Type(n)==Tex ? Length((value)(n)) : (n)->n_width)
+#define marked(p, x) (marks(tree(p))&(x))
+
+#define Pnil ((path) NULL)
+
+path newpath();
+
+#define parent(p) ((p)->p_parent)
+#define tree(p) ((p)->p_tree)
+#define ichild(p) ((p)->p_ichild)
+
+#define Ycoord(p) ((p)->p_ycoord)
+#define Xcoord(p) ((p)->p_xcoord)
+#define Level(p) ((p)->p_level)
+
+/* Procedure markpath(); */
+/* Procedure unmkpath(); */
+/* Procedure replace(); */
+bool up();
+bool downi();
+
+#define down(n) downi(n, 1)
+
+bool downrite();
+bool left();
+bool rite();
+/* Procedure top(); */
+bool nextnode();
+/* Procedure firstleaf(); */
+bool nextleaf();
+bool prevnode();
+/* Procedure lastleaf(); */
+bool prevleaf();
+bool nextmarked();
+bool prevmarked();
+
+/*
+ * The following are routines for lint, but macros for CC.
+ * This way lint can detect wrong arguments passed.
+ */
+
+#ifdef lint
+
+node nodecopy();
+noderelease();
+nodeuniql();
+
+path pathcopy();
+pathrelease();
+pathuniql();
+
+#else
+
+#define nodecopy(n) ((node)copy(n))
+#define noderelease(n) release(n)
+#define nodeuniql(pn) uniql(pn)
+
+#define pathcopy(p) ((path)copy(p))
+#define pathrelease(p) release(p)
+#define pathuniql(pp) uniql(pp)
+
+#endif
+
+node grab_node();
+path grab_path();
diff --git a/usr/contrib/B/src/bed/queu.h b/usr/contrib/B/src/bed/queu.h
new file mode 100644 (file)
index 0000000..cc0b06a
--- /dev/null
@@ -0,0 +1,24 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: queu.h,v 2.1 85/08/22 16:07:02 timo Exp $ */
+
+/*
+ * B editor -- Definitions for queues of nodes.
+ */
+
+typedef struct queue *queue;
+
+struct queue {
+       char    type;
+       char    _unused;
+       intlet  refcnt;
+       intlet  len;
+       node    q_data;
+       queue   q_link;
+};
+
+#define Qnil ((queue) NULL)
+#define qcopy(q) ((queue)copy((value)(q)))
+#define qrelease(q) release((value)(q))
+#define emptyqueue(q) (!(q))
+
+node queuebehead();
diff --git a/usr/contrib/B/src/bed/supr.h b/usr/contrib/B/src/bed/supr.h
new file mode 100644 (file)
index 0000000..6351639
--- /dev/null
@@ -0,0 +1,60 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: supr.h,v 2.2 84/07/11 15:20:05 guido Exp $ */
+
+/*
+ * B editor -- Superstructure for fine focusing.
+ */
+
+/*
+ * Interpretation of mode and s1, s2, s3:
+ * WHOLE: whole node is the focus;
+ * SUBSET: s1/2, s2/2 are first and last child number under focus;
+ *         even means fixed text, odd means child node;
+ * SUBRANGE: s1/2 is fixed text number; s2, s3 are 1st&last char;
+ *         if s1 is odd, ditto for child which must be "text";
+ * VHOLE: s1/2 is fixed text number; volatile hole before char s2;
+ *         if s1 is odd, ditto for child which must be "text".
+ * ATEND: a volatile hole just after the entire node.
+ * ATBEGIN: ditto just before it.
+ * SUBLIST: s3 indicates how many times downrite() bring us
+ *         beyond the focus (i.e., the focus is the subtree below
+ *         ep->focus EXCLUDING the subtree reached after s3 times
+ *         downrite().  Note s3 > 0.
+ * FHOLE: Like VHOLE but in Fixed text.
+ *
+ * It is assumed that if the focus is a substring of fixed text
+ * (SUBRANGE, VHOLE), it does not begin or end with lay-out of spaces.
+ */
+
+#define WHOLE  'W'
+#define SUBSET 'S'
+#define SUBRANGE       'R'
+#define VHOLE  'V'
+#define ATEND  'E'
+#define ATBEGIN        'B'
+#define SUBLIST        'L'
+#define FHOLE  'F'
+
+typedef struct {
+       path focus;
+       char mode;
+       char /*bool*/ copyflag;
+       char /*bool*/ spflag;
+       char /*bool*/ changed;
+       short /*0..2*MAXCHILD+1*/ s1;
+       short s2;
+       short s3;
+       short highest;
+       value copybuffer; /* Actually, a queue */
+       value oldmacro; /* A text */
+       value newmacro; /* A text, too */
+       int generation;
+} environ;
+
+#ifdef STRUCTASS
+#define Emove(e1, e2) ((e2) = (e1))
+#else !STRUCTASS
+#define Emove(e1, e2) emove(&(e1), &(e2))
+#endif !STRUCTASS
+#define Ecopy(e1, e2) ecopy(&(e1), &(e2))
+#define Erelease(e) erelease(&(e))
diff --git a/usr/contrib/B/src/bed/syms.h b/usr/contrib/B/src/bed/syms.h
new file mode 100644 (file)
index 0000000..ca26e5c
--- /dev/null
@@ -0,0 +1,127 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
+/* $Header: syms.h,v 1.1 85/08/22 15:44:34 timo Exp $ */
+
+/*
+ * B editor -- Grammar symbol definitions.
+ */
+
+/*
+ * Values returned by function symbol(n).
+ * They are used directly as index in the grammar table.
+ * The NAMES of the #defined constants are of no importance outside this file.
+ */
+
+#define Put    1
+#define Insert 2
+#define Remove 3
+#define Choose 4
+#define Draw   5
+#define Set_random     6
+#define Delete 7
+#define Check  8
+#define Share  9
+
+#define Write  10
+#define Read   11
+#define Read_raw       12
+
+#define If     13
+#define While  14
+#define For    15
+
+#define Select 16
+
+#define Quit   18
+#define Return 19
+#define Report 20
+#define Succeed        21
+#define Fail   22
+
+#define How_to 23
+#define Yield  24
+#define Test   25
+#define Suite  26
+#define Refinement     27
+
+#define Compound       28
+#define Collateral     29
+#define Tag    30
+#define Number 31
+#define Selection      32
+#define Behead 33
+#define Curtail        34
+
+#define And    35
+#define Or     36
+#define Not    37
+#define Some_in        38
+#define Each_in        39
+#define No_in  40
+#define Some_parsing   41
+#define Each_parsing   42
+#define No_parsing     43
+
+#define Comment        44
+#define Keyword        45
+
+#define L_t_dis        46
+#define List_body      47
+#define Tab_body       48
+#define Tab_entry      49
+
+#define E_number       50
+#define Com_target     51
+#define Col_target     52
+#define Sel_expr       53
+#define Text1  54
+#define Text2  55
+#define Grouped        56
+#define Blocked        57
+#define Operators      58
+
+#define Else_kw        59
+#define Kw_plus        60
+#define E_plus 61
+#define Conversion     62
+#define T1     63
+#define T1_plus        64
+#define T2     65
+#define T2_plus        66
+#define Cmt_cmd        67
+
+#define F_kw_plus      69
+#define F_e_plus       70
+#define Plus_sign      71
+#define Minus_sign     72
+
+#define Long_comp      73
+#define Short_comp     74
+#define Cmt_comp       75
+
+#define Long_unit      76
+#define Short_unit     77
+#define Cmt_head       78
+
+#define Ref_join       79
+
+#define And_kw 80
+#define Or_kw  81
+
+#define E_part 82
+
+#define Unit_edit      83
+#define Target_edit    84
+#define Imm_cmd        85
+#define Raw    86
+#define Raw_input      87
+#define Edit_unit      88
+#define Edit_target    89
+#define Colon  90
+#define Equals 91
+#define Test_suite     92
+#define Expression     93
+
+/*
+ * The last three, `Suggestion', `Optional' and `Hole',
+ * with values 97, 98 and 99, are defined in "gram.h".
+ */
diff --git a/usr/contrib/B/src/bed/tabl.h b/usr/contrib/B/src/bed/tabl.h
new file mode 100644 (file)
index 0000000..f188883
--- /dev/null
@@ -0,0 +1,44 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: tabl.h,v 2.0 84/06/18 15:47:24 guido Exp $ */
+
+/*
+ * B editor -- Grammar table structure.
+ */
+
+
+typedef char classelem;
+       /* change into short if symbol or lexical values can exceed 127! */
+
+typedef classelem *classptr;
+
+struct classinfo {
+       classptr c_class; /* List of possible classes */
+               /* The following fields are initialized dynamically */
+       classptr c_insert; /* List of pairs (char, class) for insertion */
+       classptr c_append; /* Ditto for append to child already there */
+       classptr c_join; /* Ditto for join of child with new node */
+};
+
+#define MAXCHILD 4 /* Max. # of children per node. */
+
+
+struct table {
+       short r_symbol; /* Redundant, used for checking consistency */
+       string r_name;
+       string r_repr[MAXCHILD+1];
+               /* There are entries [0..nch] inclusive. */
+       struct classinfo *r_class[MAXCHILD];
+               /* Must be indexed with [ich-1] !! */
+       node r_node;
+};
+
+extern struct table *table;
+
+#define TABLEN (Hole+1)
+
+extern char code_array[];
+extern char invcode_array[];
+extern int lastcode;
+
+#define Code(c) code_array[c]
+#define Invcode(code) invcode_array[code]
diff --git a/usr/contrib/B/src/bed/unix.h b/usr/contrib/B/src/bed/unix.h
new file mode 100644 (file)
index 0000000..0fd58ff
--- /dev/null
@@ -0,0 +1,22 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: unix.h,v 2.4 85/08/22 16:09:55 timo Exp $ */
+
+/*
+ * B editor -- inventory of available UNIX features.
+ */
+
+#ifdef BSD
+#define VFORK  /* 4.x BSD vfork() system call available */
+#endif
+
+#ifdef BSD4_2
+#define SELECT /* 4.2 BSD select() system call available */
+#endif
+
+#define SIGNAL /* can #include <signal.h> (v7 or any BSD compatible) */
+#define SETJMP /* can #include <setjmp.h> */
+#define SGTTY_H        /* can #include <sgtty.h> (at least v7 compatible) */
+
+#define PERROR /* can use perror(), sys_errlist and sys_nerr */
+
+/* #define PWB */      /* Turn on for PWB/UNIX systems without getenv etc. */
diff --git a/usr/contrib/B/src/bed/vtrm.h b/usr/contrib/B/src/bed/vtrm.h
new file mode 100644 (file)
index 0000000..40ca377
--- /dev/null
@@ -0,0 +1,11 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
+
+/*
+  $Header: vtrm.h,v 1.1 85/08/22 15:50:08 timo Exp $
+*/
+
+/* some capabilities, exported by trmstart */
+#define HAS_STANDOUT   1
+#define CAN_SCROLL     2
+#define CAN_OPTIMISE   4
+#define CAN_SENSE      8