4.3BSD/usr/contrib/B/src/bsmall/B1val.c

/* 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;
}