2.11BSD#431 - /usr/src/new/PORT/B/src/bsmall/B1val.c

   1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
   2: /* $Header: B1val.c,v 1.1 84/06/28 00:49:01 timo Exp $ */
   3: 
   4: /* General operations for objects */
   5: 
   6: #include "b.h"
   7: #include "b0con.h"
   8: #include "b1obj.h"
   9: #include "b1mem.h"
  10: #include "b2scr.h" /* TEMPORARY for at_nwl */
  11: #include "b2sem.h" /* TEMPORARY for grab */
  12: #ifndef SMALLNUMBERS
  13: #include "b1num.h" /* for ccopy, rrelease, grab, grab_num, grab_rat, grab_approx */
  14: #else
  15: #include "B1num.h" /* For grab */
  16: #endif
  17: 
  18: 
  19: #define LL (len < 200 ? 1 : 8)
  20: #define Len (len == 0 ? 0 : ((len-1)/LL+1)*LL)
  21: #define Adj(s) (unsigned) (sizeof(*Vnil)-sizeof(Vnil->cts)+(s))
  22: 
  23: #define Grabber() {if(len>Maxintlet)syserr("big grabber");}
  24: #define Regrabber() {if(len>Maxintlet)syserr("big regrabber");}
  25: 
  26: value etxt, elis, etab, elt;
  27: 
  28: long gr= 0;
  29: 
  30: Visible Procedure prgr() {at_nwl=No;printf(" gr:%ld",gr);gr=0;}
  31: 
  32: Hidden value grab(type, len) literal type; intlet len; {
  33:     unsigned syze; value v;
  34:     Grabber();
  35:     switch (type) {
  36:     case Num:
  37: #ifdef SMALLNUMBERS
  38:         syze= sizeof(number);
  39: #else
  40:         if (len >= 0) syze= Len*sizeof(digit);      /* Integral */
  41:         else if (len == -1) syze= sizeof(double);   /* Approximate */
  42:         else syze= 2*sizeof(value);         /* Rational */
  43: #endif
  44:         break;
  45:     case Tex: syze= (len+1)*sizeof(char); break; /* one extra for the '\0' */
  46:     case Com: syze= len*sizeof(value); break;
  47:     case ELT: syze= (len= 0); break;
  48:     case Lis:
  49:     case Tab: syze= Len*sizeof(value); break;
  50:     case Sim: syze= sizeof(simploc); break;
  51:     case Tri: syze= sizeof(trimloc); break;
  52:     case Tse: syze= sizeof(tbseloc); break;
  53:     case How: syze= sizeof(how); break;
  54:     case For: syze= sizeof(formal); break;
  55:     case Glo: syze= 0; break;
  56:     case Per: syze= sizeof(value); break;
  57:     case Fun:
  58:     case Prd: syze= sizeof(funprd); break;
  59:     case Ref: syze= sizeof(ref); break;
  60:     default:
  61:         printf("\ngrabtype{%c}\n", type);
  62:         syserr("grab called with unknown type");
  63:     }
  64:     v= (value) getmem(Adj(syze));
  65:     v->type= type; v->len= len; v->refcnt= 1;
  66: gr+=1;
  67:     return v;
  68: }
  69: 
  70: #ifdef SMALLNUMBERS
  71: Visible value grab_num(len) intlet len; { return grab(Num, len); }
  72: #else
  73: Visible value grab_num(len) register int len; {
  74:     integer v;
  75:     register int i;
  76: 
  77:     v = (integer) grab(Num, len);
  78:     for (i = Length(v)-1; i >= 0; --i) Digit(v, i) = 0;
  79:     return (value) v;
  80: }
  81: 
  82: Visible value grab_rat() {
  83:     return (value) grab(Num, -2);
  84: }
  85: 
  86: Visible value grab_approx() {
  87:     return (value) grab(Num, -1);
  88: }
  89: 
  90: Visible value regrab_num(v, len) value v; register int len; {
  91:     register unsigned syze;
  92: 
  93:     syze = Len * sizeof(digit);
  94:     regetmem(&v, Adj(syze));
  95:     Length(v) = len;
  96:     return v;
  97: }
  98: #endif
  99: 
 100: Visible value grab_tex(len) intlet len; {
 101:     if (len == 0) return copy(etxt);
 102:     return grab(Tex, len);
 103: }
 104: 
 105: Visible value grab_com(len) intlet len; { return grab(Com, len); }
 106: 
 107: Visible value grab_elt() { return copy(elt); }
 108: 
 109: Visible value grab_lis(len) intlet len; {
 110:     if (len == 0) return copy(elis);
 111:     return grab(Lis, len);
 112: }
 113: 
 114: Visible value grab_tab(len) intlet len; {
 115:     if (len == 0) return copy(etab);
 116:     return grab(Tab, len);
 117: }
 118: 
 119: Visible value grab_sim() { return grab(Sim, 0); }
 120: 
 121: Visible value grab_tri() { return grab(Tri, 0); }
 122: 
 123: Visible value grab_tse() { return grab(Tse, 0); }
 124: 
 125: Visible value grab_how() { return grab(How, 0); }
 126: 
 127: Visible value grab_for() { return grab(For, 0); }
 128: 
 129: Visible value grab_glo() { return grab(Glo, 0); }
 130: 
 131: Visible value grab_per() { return grab(Per, 0); }
 132: 
 133: Visible value grab_fun() { return grab(Fun, 0); }
 134: 
 135: Visible value grab_prd() { return grab(Prd, 0); }
 136: 
 137: Visible value grab_ref() { return grab(Ref, 0); }
 138: 
 139: Visible value copy(v) value v; {
 140:     if (v != Vnil && v->refcnt < Maxintlet) (v->refcnt)++;
 141:  gr+=1;
 142:     return v;
 143: }
 144: 
 145: Visible Procedure release(v) value v; {
 146:     intlet *r= &(v->refcnt);
 147:     if (v == Vnil) return;
 148:     if (*r == 0) syserr("releasing unreferenced value");
 149:  if(bugs){printf("releasing: "); if (Type(v) == Num) bugs= No; wri(v,No,No,No); bugs= Yes; line();}
 150:     if (*r < Maxintlet && --(*r) == 0) rrelease(v);
 151:  gr-=1;
 152: }
 153: 
 154: Hidden value ccopy(v) value v; {
 155:     literal type= v->type; intlet len= Length(v), k; value w;
 156:     w= grab(type, len);
 157:     switch (type) {
 158:     case Num:
 159: #ifdef SMALLNUMBERS
 160:         Numerator(w)= Numerator(v);
 161:         Denominator(w)= Denominator(v);
 162: #else
 163:         if (Integral(v)) {
 164:             register int i;
 165:             for (i = len-1; i >= 0; --i)
 166:                 Digit((integer)w, i) = Digit((integer)v, i);
 167:         } else if (Approximate(v))
 168:             Realval((real)w) = Realval((real)v);
 169:         else if (Rational(v)) {
 170:             Numerator((rational)w) =
 171:                 (integer) copy(Numerator((rational)v));
 172:             Denominator((rational)w) =
 173:                 (integer) copy(Denominator((rational)v));
 174:         }
 175: #endif
 176:         break;
 177:     case Tex:
 178:         strcpy(Str(w), Str(v));
 179:         break;
 180:     case Com:
 181:     case Lis:
 182:     case Tab:
 183:     case ELT:
 184:         {value *vp= Ats(v), *wp= Ats(w);
 185:             Overall *wp++= copy(*vp++);
 186:         } break;
 187:     case Sim:
 188:         {simploc *vv= (simploc *)Ats(v), *ww= (simploc *)Ats(w);
 189:             ww->i= copy(vv->i); ww->e= vv->e; /* No copy */
 190:         } break;
 191:     case Tri:
 192:         {trimloc *vv= (trimloc *)Ats(v), *ww= (trimloc *)Ats(w);
 193:             ww->R= copy(vv->R); ww->B= vv->B; ww->C= vv->C;
 194:         } break;
 195:     case Tse:
 196:         {tbseloc *vv= (tbseloc *)Ats(v), *ww= (tbseloc *)Ats(w);
 197:             ww->R= copy(vv->R); ww->K= copy(vv->K);
 198:         } break;
 199:     case How:
 200:         *((how *)Ats(w)) = *((how *)Ats(v));
 201:         break;
 202:     case For:
 203:         *((formal *)Ats(w)) = *((formal *)Ats(v));
 204:         break;
 205:     case Glo:
 206:         break;
 207:     case Per:
 208:         *Ats(w)= copy(*Ats(v));
 209:         break;
 210:     case Fun:
 211:     case Prd:
 212:         *((funprd *)Ats(w)) = *((funprd *)Ats(v));
 213:         break;
 214:     case Ref:
 215:         *((ref *)Ats(w)) = *((ref *)Ats(v));
 216:         break;
 217:     default:
 218:         syserr("ccopy called with unknown type");
 219:     }
 220:     return w;
 221: }
 222: 
 223: Hidden Procedure rrelease(v) value v; {
 224:     literal type= v->type; intlet len= Length(v), k;
 225:     switch (type) {
 226:     case Num:
 227: #ifndef SMALLNUMBERS
 228:         if (Rational(v)) {
 229:             release(Numerator((rational)v));
 230:             release(Denominator((rational)v));
 231:         }
 232:         break;
 233: #endif
 234:     case Tex:
 235:         break;
 236:     case Com:
 237:     case Lis:
 238:     case Tab:
 239:     case ELT:
 240:         {value *vp= Ats(v);
 241:             Overall release(*vp++);
 242:         } break;
 243:     case Sim:
 244:         {simploc *vv= (simploc *)Ats(v);
 245:             release(vv->i); /* No release of vv->e */
 246:         } break;
 247:     case Tri:
 248:         {trimloc *vv= (trimloc *)Ats(v);
 249:             release(vv->R);
 250:         } break;
 251:     case Tse:
 252:         {tbseloc *vv= (tbseloc *)Ats(v);
 253:             release(vv->R); release(vv->K);
 254:         } break;
 255:     case How:
 256:         {how *vv= (how *)Ats(v);
 257:             freemem((ptr) vv->fux);
 258:             release(vv->reftab);
 259:         } break;
 260:     case For:
 261:     case Glo:
 262:         break;
 263:     case Per:
 264:         release(*Ats(v));
 265:         break;
 266:     case Fun:
 267:     case Prd:
 268:         {funprd *vv= (funprd *)Ats(v);
 269:             if (vv->def == Use) {
 270:                 freemem((ptr) vv->fux);
 271:                 release(vv->reftab);
 272:             }
 273:         } break;
 274:     case Ref:
 275:         break;
 276:     default:
 277:         syserr("release called with unknown type");
 278:     }
 279:     v->type= '\0'; freemem((ptr) v);
 280: }
 281: 
 282: Visible Procedure uniql(ll) value *ll; {
 283:     if (*ll != Vnil && (*ll)->refcnt > 1) {
 284:         value c= ccopy(*ll);
 285:         release(*ll);
 286:         *ll= c;
 287:     }
 288: }
 289: 
 290: Visible Procedure xtndtex(a, d) value *a; intlet d; {
 291:     intlet len= Length(*a)+d;
 292:     Regrabber();
 293:     regetmem(a, Adj((len+1)*sizeof(char)));
 294:     (*a)->len= len;
 295: }
 296: 
 297: Visible Procedure xtndlt(a, d) value *a; intlet d; {
 298:     intlet len= Length(*a); intlet l1= Len, l2;
 299:     len+= d; l2= Len;
 300:     if (l1 != l2) {
 301:         Regrabber();
 302:         regetmem(a, Adj(l2*sizeof(value)));
 303:     }
 304:     (*a)->len= len;
 305: }
 306: 
 307: Visible Procedure initmem() {
 308:     etxt= grab(Tex, 0);
 309:     elis= grab(Lis, 0);
 310:     etab= grab(Tab, 0);
 311:     elt=  grab(ELT, 0);
 312:  notel= grab_lis(0); noting= No;
 313: }

Defined functions

Defined variables

Defined macros