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 (file)
index 0000000..28d6219
--- /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 (file)
index 0000000..cfe710e
--- /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 (file)
index 0000000..36cb320
--- /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 (file)
index 0000000..4e2a90f
--- /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;
+}