From: CSRG <csrg@ucbvax.Berkeley.EDU>
Date: Mon, 26 Aug 1985 19:27:56 +0000 (-0800)
Subject: BSD 4_3_Tahoe development
X-Git-Tag: BSD-4_3_Net_1^2~1272
X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/commitdiff_plain/db1275a7b7a1eec76425fe5204bfb1e5a44d6d41

BSD 4_3_Tahoe development
Work on file usr/src/new/B/src/bsmall/B1tlt.c
Work on file usr/src/new/B/src/bsmall/B1val.c
Work on file usr/src/new/B/src/bsmall/b1com.c
Work on file usr/src/new/B/src/bsmall/b1mem.c

Synthesized-from: CSRG/cd2/4.3tahoe
---

diff --git a/usr/src/new/B/src/bsmall/B1tlt.c b/usr/src/new/B/src/bsmall/B1tlt.c
new file mode 100644
index 0000000000..28d6219cf7
--- /dev/null
+++ b/usr/src/new/B/src/bsmall/B1tlt.c
@@ -0,0 +1,266 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: B1tlt.c,v 1.1 84/06/28 00:49:00 timo Exp $ */
+
+#include "b.h"
+#include "b1obj.h"
+#include "B1tlt.h"
+
+Visible value mk_elt() { return grab_elt(); }
+
+Visible value size(x) value x; { /* monadic # operator */
+	if (!Is_tlt(x)) error("in #t, t is not a text, list or table");
+	return mk_integer((int) Length(x));
+}
+
+#define Lisent(tp,k) (*(tp+(k)))
+
+Visible value size2(v, t) value v, t; { /* Dyadic # operator */
+	intlet len= Length(t), n= 0, k; value *tp= Ats(t);
+	if (!Is_tlt(t)) error("in e#t, t is not a text, list or table");
+	switch (t->type) {
+	case Tex:
+		{string cp= (string)tp; char c;
+			if (v->type != Tex)
+				error("in e#t, t is a text but e is not");
+			if (Length(v) != 1) error(
+				"in e#t, e is a text but not a character");
+			c= *Str(v);
+			Overall if (*cp++ == c) n++;
+		} break;
+	case ELT:
+		break;
+	case Lis:
+		{intlet lo= -1, mi, xx, mm, hi= len; relation c;
+		bins:	if (hi-lo < 2) break;
+			mi= (lo+hi)/2;
+			if ((c= compare(v, Lisent(tp,mi))) == 0) goto some;
+			if (c < 0) hi= mi; else lo= mi;
+			goto bins;
+		some:	xx= mi;
+			while (xx-lo > 1) {
+				mm= (lo+xx)/2;
+				if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
+				else lo= mm;
+			}
+			xx= mi;
+			while (hi-xx > 1) {
+				mm= (xx+hi)/2;
+				if (compare(v, Lisent(tp,mm)) == 0) xx= mm;
+				else hi= mm;
+			}
+			n= hi-lo-1;
+		} break;
+	case Tab:
+		Overall if (compare(v, Dts(*tp++)) == 0) n++;
+		break;
+	default:
+		syserr("e#t with non text, list or table");
+		break;
+	}
+	return mk_integer((int) n);
+}
+
+Hidden bool less(r) relation r;    { return r<0; }
+Hidden bool greater(r) relation r; { return r>0; }
+
+Hidden value mm1(t, rel) value t; bool (*rel)(); {
+	intlet len= Length(t), k; value m, *tp= Ats(t);
+	switch (t->type) {
+	case Tex:
+		{string cp= (string) tp; char mc= '\0', mm[2];
+			Overall {
+				if (mc == '\0' || ((*rel)(*cp < mc ? -1 : (*cp > mc ? 1 : 0))))
+					mc= *cp;
+				cp++;
+			}
+			mm[0]= mc; mm[1]= '\0';
+			m= mk_text(mm);
+		} break;
+	case Lis:
+		if ((*rel)(-1)) /*min*/ m= copy(*Ats(t));
+		else m= copy(*(Ats(t)+len-1));
+		break;
+	case Tab:
+		{value dm= Vnil;
+			Overall {
+				if (dm == Vnil || (*rel)(compare(Dts(*tp), dm)))
+					dm= Dts(*tp);
+				tp++;
+			}
+			m= copy(dm);
+		} break;
+	default:
+		syserr("min or max t, with non text, list or table");
+	}
+	return m;
+}
+
+Hidden value mm2(v, t, rel) value v, t; bool (*rel)(); {
+	intlet len= Length(t), k; value m= Vnil, *tp= Ats(t);
+	switch (t->type) {
+	case Tex:
+		{string cp= (string) tp; char c, mc= '\0', mm[2];
+			c= *Str(v);
+			Overall {
+				if ((*rel)(c < *cp ? -1 : c > *cp ? 1 : 0)) {
+					if (mc == '\0' || (*rel)(*cp < mc ? -1 : *cp>mc ? 1 : 0))
+						mc= *cp;
+				}
+				cp++;
+			}
+			if (mc != '\0') {
+				mm[0]= mc; mm[1]= '\0';
+				m= mk_text(mm);
+			}
+		} break;
+	case Lis:
+		{intlet lim1, mid, lim2;
+			if ((*rel)(-1)) { /*min*/
+				lim1= 1; lim2= len-1;
+			} else {
+				lim2= 1; lim1= len-1;
+			}
+			if (!(*rel)(compare(v, Lisent(tp,lim2)))) break;
+			if (len == 1 || (*rel)(compare(v, Lisent(tp,lim1)))) {
+				m= copy(Lisent(tp,lim1));
+				break;
+			}
+			/* v rel tp[lim2] && !(v rel tp[lim1]) */
+			while (abs(lim2-lim1) > 1) {
+				mid= (lim1+lim2)/2;
+				if ((*rel)(compare(v, Lisent(tp,mid)))) lim2= mid;
+				else lim1= mid;
+			}
+			m= copy(Lisent(tp,lim2));
+		} break;
+	case Tab:
+		{value dm= Vnil;
+			Overall {
+				if ((*rel)(compare(v, Dts(*tp)))) {
+					if (dm == Vnil ||
+						(*rel)(compare(Dts(*tp), dm)))
+						dm= Dts(*tp);
+				}
+				tp++;
+			}
+			if (dm != Vnil) m= copy(dm);
+		} break;
+	default:
+		syserr("min2 or max2 with non text, list or table");
+		break;
+	}
+	return m;
+}
+
+Visible value min1(t) value t; { /* Monadic min */
+	if (!Is_tlt(t)) error("in min t, t is not a text, list or table");
+	if (Length(t) == 0) error("in min t, t is empty");
+	return mm1(t, less);
+}
+
+Visible value min2(v, t) value v, t; {
+	value m;
+	if (!Is_tlt(t)) error("in e min t, t is not a text, list or table");
+	if (Length(t) == 0) error("in e min t, t is empty");
+	if (Is_text(t)) {
+		if (!Is_text(v)) error("in e min t, t is a text but e is not");
+		if (Length(v) != 1) error("in e min t, e is a text but not a character");
+	}
+	m= mm2(v, t, less);
+	if (m == Vnil) error("in e min t, no element of t exceeds e");
+	return m;
+}
+
+Visible value max1(t) value t; {
+	if (!Is_tlt(t)) error("in max t, t is not a text, list or table");
+	if (Length(t) == 0) error("in max t, t is empty");
+	return mm1(t, greater);
+}
+
+Visible value max2(v, t) value v, t; {
+	value m;
+	if (!Is_tlt(t)) error("in e max t, t is not a text, list or table");
+	if (Length(t) == 0) error("in e max t, t is empty");
+	if (Is_text(t)) {
+		if (!Is_text(v)) error("in e max t, t is a text but e is not");
+		if (Length(v) != 1) error("in e max t, e is a text but not a character");
+	}
+	m= mm2(v, t, greater);
+	if (m == Vnil) error("in e max t, no element of t is less than e");
+	return m;
+}
+
+Visible value th_of(n, t) value n, t; {
+	return thof(intval(n), t);
+}
+
+Visible value thof(n, t) int n; value t; {
+	intlet len= Length(t); value w;
+	if (!Is_tlt(t)) error("in n th'of t, t is not a text, list or table");
+	if (n <= 0 || n > len) error("in n th'of t, n is out of bounds");
+	switch (t->type) {
+	case Tex:
+		{char ww[2];
+			ww[0]= *(Str(t)+n-1); ww[1]= '\0';
+			w= mk_text(ww);
+		} break;
+	case Lis:
+		w= copy(*(Ats(t)+n-1));
+		break;
+	case Tab:
+		w= copy(Dts(*(Ats(t)+n-1)));
+		break;
+	default:
+		syserr("th'of with non text, list or table");
+	}
+	return w;
+}
+
+Visible bool found(elem, v, probe, where)
+	value (*elem)(), v, probe; intlet *where;
+	/* think of elem(v,lo-1) as -Infinity and elem(v,hi+1) as +Infinity.
+	   found and where at the end satisfy:
+	   SELECT:
+	       SOME k IN {lo..hi} HAS probe = elem(v,k):
+	           found = Yes AND where = k
+	       ELSE: found = No AND elem(v,where-1) < probe < elem(v,where).
+	*/
+{relation c; intlet lo=0, hi= Length(v)-1;
+	if (lo > hi) { *where= lo; return No; }
+	if ((c= compare(probe, (*elem)(v, lo))) == 0) {*where= lo; return Yes; }
+	if (c < 0) { *where=lo; return No; }
+	if (lo == hi) { *where=hi+1; return No; }
+	if ((c= compare(probe, (*elem)(v, hi))) == 0) { *where=hi; return Yes; }
+	if (c > 0) { *where=hi+1; return No; }
+	/* elem(lo) < probe < elem(hi) */
+	while (hi-lo > 1) {
+		if ((c= compare(probe, (*elem)(v, (lo+hi)/2))) == 0) {
+			*where= (lo+hi)/2; return Yes;
+		}
+		if (c < 0) hi= (lo+hi)/2; else lo= (lo+hi)/2;
+	}
+	*where= hi; return No;
+}
+
+Visible bool in(v, t) value v, t; {
+	intlet where, k, len= Length(t); value *tp= Ats(t);
+	if (!Is_tlt(t)) error("in the test e in t, t is not a text, list or table");
+	switch (t->type) {
+	case Tex:
+		if (v->type != Tex)
+			error("in the test e in t, t is a text but e is not");
+		if (Length(v) != 1)
+			error("in the test e in t, e is a text but not a character");
+		return index((string) tp, *Str(v)) != 0;
+	case ELT:
+		return No;
+	case Lis:
+		return found(list_elem, t, v, &where);
+	case Tab:
+		Overall if (compare(v, Dts(*tp++)) == 0) return Yes;
+		return No;
+	default:
+		syserr("e in t with non text, list or table");
+		return No;
+	}
+}
diff --git a/usr/src/new/B/src/bsmall/B1val.c b/usr/src/new/B/src/bsmall/B1val.c
new file mode 100644
index 0000000000..cfe710ed8e
--- /dev/null
+++ b/usr/src/new/B/src/bsmall/B1val.c
@@ -0,0 +1,313 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: B1val.c,v 1.1 84/06/28 00:49:01 timo Exp $ */
+
+/* General operations for objects */
+
+#include "b.h"
+#include "b0con.h"
+#include "b1obj.h"
+#include "b1mem.h"
+#include "b2scr.h" /* TEMPORARY for at_nwl */
+#include "b2sem.h" /* TEMPORARY for grab */
+#ifndef SMALLNUMBERS
+#include "b1num.h" /* for ccopy, rrelease, grab, grab_num, grab_rat, grab_approx */
+#else
+#include "B1num.h" /* For grab */
+#endif
+
+
+#define LL (len < 200 ? 1 : 8)
+#define Len (len == 0 ? 0 : ((len-1)/LL+1)*LL)
+#define Adj(s) (unsigned) (sizeof(*Vnil)-sizeof(Vnil->cts)+(s))
+
+#define Grabber() {if(len>Maxintlet)syserr("big grabber");}
+#define Regrabber() {if(len>Maxintlet)syserr("big regrabber");}
+
+value etxt, elis, etab, elt;
+
+long gr= 0;
+
+Visible Procedure prgr() {at_nwl=No;printf(" gr:%ld",gr);gr=0;}
+
+Hidden value grab(type, len) literal type; intlet len; {
+	unsigned syze; value v;
+	Grabber();
+	switch (type) {
+	case Num:
+#ifdef SMALLNUMBERS
+		syze= sizeof(number);
+#else
+		if (len >= 0) syze= Len*sizeof(digit);		/* Integral */
+		else if (len == -1) syze= sizeof(double);	/* Approximate */
+		else syze= 2*sizeof(value);			/* Rational */
+#endif
+		break;
+	case Tex: syze= (len+1)*sizeof(char); break; /* one extra for the '\0' */
+	case Com: syze= len*sizeof(value); break;
+	case ELT: syze= (len= 0); break;
+	case Lis:
+	case Tab: syze= Len*sizeof(value); break;
+	case Sim: syze= sizeof(simploc); break;
+	case Tri: syze= sizeof(trimloc); break;
+	case Tse: syze= sizeof(tbseloc); break;
+	case How: syze= sizeof(how); break;
+	case For: syze= sizeof(formal); break;
+	case Glo: syze= 0; break;
+	case Per: syze= sizeof(value); break;
+	case Fun:
+	case Prd: syze= sizeof(funprd); break;
+	case Ref: syze= sizeof(ref); break;
+	default:
+		printf("\ngrabtype{%c}\n", type);
+		syserr("grab called with unknown type");
+	}
+	v= (value) getmem(Adj(syze));
+	v->type= type; v->len= len; v->refcnt= 1;
+gr+=1;
+	return v;
+}
+
+#ifdef SMALLNUMBERS
+Visible value grab_num(len) intlet len; { return grab(Num, len); }
+#else
+Visible value grab_num(len) register int len; {
+	integer v;
+	register int i;
+
+	v = (integer) grab(Num, len);
+	for (i = Length(v)-1; i >= 0; --i) Digit(v, i) = 0;
+	return (value) v;
+}
+
+Visible value grab_rat() {
+	return (value) grab(Num, -2);
+}
+
+Visible value grab_approx() {
+	return (value) grab(Num, -1);
+}
+
+Visible value regrab_num(v, len) value v; register int len; {
+	register unsigned syze;
+
+	syze = Len * sizeof(digit);
+	regetmem(&v, Adj(syze));
+	Length(v) = len;
+	return v;
+}
+#endif
+
+Visible value grab_tex(len) intlet len; {
+	if (len == 0) return copy(etxt);
+	return grab(Tex, len);
+}
+
+Visible value grab_com(len) intlet len; { return grab(Com, len); }
+
+Visible value grab_elt() { return copy(elt); }
+
+Visible value grab_lis(len) intlet len; {
+	if (len == 0) return copy(elis);
+	return grab(Lis, len);
+}
+
+Visible value grab_tab(len) intlet len; {
+	if (len == 0) return copy(etab);
+	return grab(Tab, len);
+}
+
+Visible value grab_sim() { return grab(Sim, 0); }
+
+Visible value grab_tri() { return grab(Tri, 0); }
+
+Visible value grab_tse() { return grab(Tse, 0); }
+
+Visible value grab_how() { return grab(How, 0); }
+
+Visible value grab_for() { return grab(For, 0); }
+
+Visible value grab_glo() { return grab(Glo, 0); }
+
+Visible value grab_per() { return grab(Per, 0); }
+
+Visible value grab_fun() { return grab(Fun, 0); }
+
+Visible value grab_prd() { return grab(Prd, 0); }
+
+Visible value grab_ref() { return grab(Ref, 0); }
+
+Visible value copy(v) value v; {
+	if (v != Vnil && v->refcnt < Maxintlet) (v->refcnt)++;
+ gr+=1;
+	return v;
+}
+
+Visible Procedure release(v) value v; {
+	intlet *r= &(v->refcnt);
+	if (v == Vnil) return;
+	if (*r == 0) syserr("releasing unreferenced value");
+ if(bugs){printf("releasing: "); if (Type(v) == Num) bugs= No; wri(v,No,No,No); bugs= Yes; line();}
+	if (*r < Maxintlet && --(*r) == 0) rrelease(v);
+ gr-=1;
+}
+
+Hidden value ccopy(v) value v; {
+	literal type= v->type; intlet len= Length(v), k; value w;
+	w= grab(type, len);
+	switch (type) {
+	case Num:
+#ifdef SMALLNUMBERS
+		Numerator(w)= Numerator(v);
+		Denominator(w)= Denominator(v);
+#else
+		if (Integral(v)) {
+			register int i;
+			for (i = len-1; i >= 0; --i)
+				Digit((integer)w, i) = Digit((integer)v, i);
+		} else if (Approximate(v))
+			Realval((real)w) = Realval((real)v);
+		else if (Rational(v)) {
+			Numerator((rational)w) =
+				(integer) copy(Numerator((rational)v));
+			Denominator((rational)w) =
+				(integer) copy(Denominator((rational)v));
+		}
+#endif
+		break;
+	case Tex:
+		strcpy(Str(w), Str(v));
+		break;
+	case Com:
+	case Lis:
+	case Tab:
+	case ELT:
+		{value *vp= Ats(v), *wp= Ats(w);
+			Overall *wp++= copy(*vp++);
+		} break;
+	case Sim:
+		{simploc *vv= (simploc *)Ats(v), *ww= (simploc *)Ats(w);
+			ww->i= copy(vv->i); ww->e= vv->e; /* No copy */
+		} break;
+	case Tri:
+		{trimloc *vv= (trimloc *)Ats(v), *ww= (trimloc *)Ats(w);
+			ww->R= copy(vv->R); ww->B= vv->B; ww->C= vv->C;
+		} break;
+	case Tse:
+		{tbseloc *vv= (tbseloc *)Ats(v), *ww= (tbseloc *)Ats(w);
+			ww->R= copy(vv->R); ww->K= copy(vv->K);
+		} break;
+	case How:
+		*((how *)Ats(w)) = *((how *)Ats(v));
+		break;
+	case For:
+		*((formal *)Ats(w)) = *((formal *)Ats(v));
+		break;
+	case Glo:
+		break;
+	case Per:
+		*Ats(w)= copy(*Ats(v));
+		break;
+	case Fun:
+	case Prd:
+		*((funprd *)Ats(w)) = *((funprd *)Ats(v));
+		break;
+	case Ref:
+		*((ref *)Ats(w)) = *((ref *)Ats(v));
+		break;
+	default:
+		syserr("ccopy called with unknown type");
+	}
+	return w;
+}
+
+Hidden Procedure rrelease(v) value v; {
+	literal type= v->type; intlet len= Length(v), k;
+	switch (type) {
+	case Num:
+#ifndef SMALLNUMBERS
+		if (Rational(v)) {
+			release(Numerator((rational)v));
+			release(Denominator((rational)v));
+		}
+		break;
+#endif
+	case Tex:
+		break;
+	case Com:
+	case Lis:
+	case Tab:
+	case ELT:
+		{value *vp= Ats(v);
+			Overall release(*vp++);
+		} break;
+	case Sim:
+		{simploc *vv= (simploc *)Ats(v);
+			release(vv->i); /* No release of vv->e */
+		} break;
+	case Tri:
+		{trimloc *vv= (trimloc *)Ats(v);
+			release(vv->R);
+		} break;
+	case Tse:
+		{tbseloc *vv= (tbseloc *)Ats(v);
+			release(vv->R); release(vv->K);
+		} break;
+	case How:
+		{how *vv= (how *)Ats(v);
+			freemem((ptr) vv->fux);
+			release(vv->reftab);
+		} break;
+	case For:
+	case Glo:
+		break;
+	case Per:
+		release(*Ats(v));
+		break;
+	case Fun:
+	case Prd:
+		{funprd *vv= (funprd *)Ats(v);
+			if (vv->def == Use) {
+				freemem((ptr) vv->fux);
+				release(vv->reftab);
+			}
+		} break;
+	case Ref:
+		break;
+	default:
+		syserr("release called with unknown type");
+	}
+	v->type= '\0'; freemem((ptr) v);
+}
+
+Visible Procedure uniql(ll) value *ll; {
+	if (*ll != Vnil && (*ll)->refcnt > 1) {
+		value c= ccopy(*ll);
+		release(*ll);
+		*ll= c;
+	}
+}
+
+Visible Procedure xtndtex(a, d) value *a; intlet d; {
+	intlet len= Length(*a)+d;
+	Regrabber();
+	regetmem(a, Adj((len+1)*sizeof(char)));
+	(*a)->len= len;
+}
+
+Visible Procedure xtndlt(a, d) value *a; intlet d; {
+	intlet len= Length(*a); intlet l1= Len, l2;
+	len+= d; l2= Len;
+	if (l1 != l2) {
+		Regrabber();
+		regetmem(a, Adj(l2*sizeof(value)));
+	}
+	(*a)->len= len;
+}
+
+Visible Procedure initmem() {
+	etxt= grab(Tex, 0);
+	elis= grab(Lis, 0);
+	etab= grab(Tab, 0);
+	elt=  grab(ELT, 0);
+ notel= grab_lis(0); noting= No;
+}
diff --git a/usr/src/new/B/src/bsmall/b1com.c b/usr/src/new/B/src/bsmall/b1com.c
new file mode 100644
index 0000000000..36cb320797
--- /dev/null
+++ b/usr/src/new/B/src/bsmall/b1com.c
@@ -0,0 +1,77 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: b1com.c,v 1.1 84/06/28 00:49:03 timo Exp $ */
+
+/************************************************************************/
+/* B compounds                                                          */
+/* plus Hows Funs and other odd types that don't fit anywhere else      */
+/*                                                                      */
+/* A compound is modelled as a sequence of len values, its fields.      */
+/*                                                                      */
+/************************************************************************/
+
+#include "b.h"
+#include "b1obj.h"
+
+Visible value* field(v, k) value v; intlet k; { /* k in {0..size-1}; no copy */
+	return (value *) Field(v, k);
+}
+
+Visible Procedure put_in_field(v, c, i) value v, *c; intlet i; {
+	/*Note that no copy of v is made: the caller must do this*/
+	*(Ats(*c)+i)= v;
+}
+
+/* Other types */
+Visible loc mk_simploc(id, en) basidf id; env en; {
+	loc l= grab_sim();
+	(*Ats(l))= copy(id); (*(Ats(l)+1))= (value) en;
+	return l;
+}
+
+Visible loc mk_trimloc(R, B, C) loc R; intlet B, C; {
+	loc l= grab_tri(); trimloc *ll= (trimloc *)Ats(l);
+	ll->R= copy(R); ll->B= B; ll->C= C;
+	return l;
+}
+
+Visible loc mk_tbseloc(R, K) loc R; value K; {
+	loc l= grab_tse(); tbseloc *ll= (tbseloc *)Ats(l);
+	ll->R= copy(R); ll->K= copy(K);
+	return l;
+}
+
+Visible fun mk_fun(L, H, adic, def, fux, lux, reftab, filed)
+ intlet L, H; literal adic, def; txptr fux, lux; value reftab; bool filed; {
+	fun f= grab_fun(); funprd *ff= (funprd *)Ats(f);
+	ff->L= L; ff->H= H; ff->adic= adic; ff->def= def; ff->fux= fux;
+	ff->lux= lux; ff->reftab= reftab; ff->filed= filed;
+	return f;
+}
+
+Visible prd mk_prd(adic, def, fux, lux, reftab, filed)
+ literal adic, def; txptr fux, lux; value reftab; bool filed; {
+	prd p= grab_prd(); funprd *pp= (funprd *)Ats(p);
+	pp->adic= adic; pp->def= def; pp->fux= fux;
+	pp->lux= lux; pp->reftab= reftab; pp->filed= filed;
+	return p;
+}
+
+Visible value mk_how(fux, lux, reftab, filed)
+ txptr fux, lux; value reftab; bool filed; {
+	value h= grab_how(); how *hh= (how *)Ats(h);
+	hh->fux= fux; hh->lux= lux; hh->reftab= reftab; hh->filed= filed;
+	return h;
+}
+
+Visible value mk_ref(rp, rlino) txptr rp; intlet rlino; {
+	value r= grab_ref();
+	((ref *)Ats(r))->rp= rp;
+	((ref *)Ats(r))->rlino= rlino;
+	return r;
+}
+
+Visible value mk_per(v) value v; {
+	value p= grab_per();
+	*Ats(p)= copy(v);
+	return p;
+}
diff --git a/usr/src/new/B/src/bsmall/b1mem.c b/usr/src/new/B/src/bsmall/b1mem.c
new file mode 100644
index 0000000000..4e2a90f7bc
--- /dev/null
+++ b/usr/src/new/B/src/bsmall/b1mem.c
@@ -0,0 +1,91 @@
+/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
+/* $Header: b1mem.c,v 1.2 84/07/19 14:09:35 guido Exp $ */
+
+/* B memory management */
+
+#include "b.h"
+#include "b1obj.h"
+#include "b1mem.h"
+
+#define Plausible(syze) {if ((int) (syze) < 0) \
+	error("creating value of exceedingly large size");}
+
+#define Note(p) /* note(p) */
+#define deNote(p) /* denote(p) */
+
+Visible ptr getmem(syze) unsigned syze; {
+	ptr p;
+	Plausible(syze);
+	p= (ptr) malloc(syze);
+	Note(p);
+	if (bugs || p==Nil) printf("{%u}",syze);
+	if (p == Nil) memexh();
+	return p;
+}
+
+Visible Procedure regetmem(v, syze) value *v; unsigned syze; {
+	Plausible(syze);
+	uniql(v);
+	if (bugs) printf("[%u]",syze);
+	criton();
+	deNote((ptr)*v);
+	*v= (value) realloc((ptr) *v, syze);
+	Note((ptr)*v);
+	critoff();
+	if ((ptr) *v == Nil) memexh();
+}
+
+Visible Procedure freemem(p) ptr p; {
+	deNote(p);
+	free(p);
+}
+
+value notel; bool noting=Yes;
+
+Hidden Procedure note(p) int p; {
+	if (!noting) {
+		value ip;
+		noting= Yes;
+		insert(ip= mk_integer(p), &notel);
+		release(ip);
+		noting= No;
+	}
+}
+
+Hidden Procedure denote(p) int p; {
+	if (!noting) {
+		value ip;
+		noting= Yes;
+		if (!in(ip= mk_integer(p), notel))
+			syserr("releasing illegally");
+		remove(ip, &notel);
+		release(ip);
+		noting= No;
+	}
+}
+
+/*
+ * Hack to delay (but not ignore) interrupts during realloc calls.
+ */
+
+#include <signal.h>
+
+Hidden int (*inthandler)();
+Hidden bool intrupted;
+
+Hidden Procedure sighold(sig) int sig; {
+	signal(sig, sighold);
+	intrupted= Yes;
+}
+
+Hidden Procedure criton() {
+	intrupted= No;
+	inthandler= signal(SIGINT, sighold);
+}
+
+Hidden Procedure critoff() {
+	signal(SIGINT, inthandler);
+	if (intrupted && inthandler != SIG_IGN && inthandler != SIG_DFL)
+		(*inthandler)(SIGINT);
+	intrupted= No;
+}