1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
   2: 
   3: /*
   4:   $Header: b1val.c,v 1.4 85/08/22 16:53:49 timo Exp $
   5: */
   6: 
   7: /* General operations for objects */
   8: 
   9: #include "b.h"
  10: #include "b0con.h"
  11: #include "b1obj.h"
  12: #include "b1mem.h"
  13: #ifndef INTEGRATION
  14: #include "b1btr.h"
  15: #include "b1val.h"
  16: #endif
  17: #include "b1tlt.h"
  18: #include "b2nod.h" /* for _Nbranches */
  19: #include "b3scr.h" /* TEMPORARY for at_nwl */
  20: #include "b1num.h" /* for ccopy, rrelease, grab, grab_num, grab_rat, grab_approx */
  21: #ifdef INTEGRATION
  22: #include "node.h"
  23: #endif INTEGRATION
  24: 
  25: #ifdef vax
  26: /* 4.2 BSD malloc already takes care of using a small number of sizes */
  27: #define Len len
  28: #else
  29: #define Len (len < 200 ? len : ((len-1)/8+1)*8)
  30: #endif
  31: 
  32: #define Hdrsize (sizeof(struct value)-sizeof(string))
  33: #define Tsize (sizeof(a_telita))
  34: #define Adj(s) (unsigned) (Hdrsize+(s))
  35: #define Unadj(s) (unsigned) ((s)-Hdrsize)
  36: #define NodOffset (sizeof(int) + 2*sizeof(intlet))
  37: 
  38: #define Grabber() {if(len>Maxintlet)syserr(MESS(1800, "big grabber"));}
  39: #define Regrabber() {if(len>Maxintlet)syserr(MESS(1801, "big regrabber"));}
  40: 
  41: /*************************** Grabbing ***********************************/
  42: 
  43: #ifdef NOT_USED
  44: long gr= 0;
  45: 
  46: Visible Procedure prgr() {at_nwl=No;printf(" gr:%ld",gr);gr=0;}
  47: #endif
  48: 
  49: Hidden unsigned
  50: getsyze(type, len, pnptrs)
  51:     literal type; intlet len; int *pnptrs;
  52: {
  53:     register unsigned syze= 0;
  54:     register int nptrs= 0;
  55:     switch (type) {
  56:     case Num:
  57:         if (len >= 0) syze= Len*sizeof(digit);     /* Integral */
  58:         else if (len == -1) {
  59: #ifdef EXT_RANGE
  60:             syze= 2*sizeof(double);        /* Approximate */
  61: #else
  62:             syze= sizeof(double);          /* Approximate */
  63: #endif
  64:         }
  65:         else { syze= 2*sizeof(value); nptrs= 2; }  /* Rational */
  66:         break;
  67:     case Ptn: len= _Nbranches(len);
  68:         syze= (len+2)*sizeof(value); nptrs= len; break;
  69:     case Com: syze= len*sizeof(value); nptrs= len; break;
  70: 
  71:     case Sim: syze= sizeof(simploc); nptrs= 1; break;
  72:     case Tri: syze= sizeof(trimloc); nptrs= 3; break;
  73:     case Tse: syze= sizeof(tbseloc); nptrs= 2; break;
  74:     case How: syze= sizeof(how); nptrs= 1; break;
  75:     case For: syze= sizeof(formal); nptrs= 1; /*uname!*/ break;
  76:     case Per: syze= sizeof(per); nptrs= 1; break;
  77:     case Fun:
  78:     case Prd: syze= sizeof(funprd); nptrs= 1; break;
  79:     case Ref: syze= sizeof(ref); nptrs= 1; break;
  80: #ifndef INTEGRATION
  81:     case Tex:
  82:     case ELT:
  83:     case Lis:
  84:     case Tab: syze= sizeof(value); nptrs= 1; break;
  85: #else
  86:     case Tex: syze= (len+1)*sizeof(char); break;
  87:     case ELT:
  88:     case Lis:
  89:     case Tab: syze = Len*sizeof(value); nptrs= len; break;
  90:     case Pat: syze= sizeof(struct path) - Hdrsize; nptrs= 2; break;
  91:     case Nod: syze= sizeof(struct node) - Hdrsize - sizeof(node)
  92:             + len*sizeof(node);
  93:           nptrs= len; break;
  94: #endif
  95:     default:
  96:         printf("\ngetsyze{%c}\n", type);
  97:         syserr(MESS(1803, "getsyze called with unknown type"));
  98:     }
  99:     if (pnptrs != NULL) *pnptrs= nptrs;
 100:     return syze;
 101: }
 102: 
 103: Hidden value
 104: grab(type, len)
 105:     literal type; intlet len;
 106: {
 107:     unsigned syze= getsyze(type, len, (int*)NULL);
 108:     value v;
 109:     Grabber();
 110:     v= (value) getmem(Adj(syze));
 111:     v->type= type; v->len= len; v->refcnt= 1;
 112: #ifdef NOT_USED
 113:  gr+=1;
 114: #endif
 115:     return v;
 116: }
 117: 
 118: #ifndef INTEGRATION
 119: 
 120: Visible value grab_tlt(type, it) literal type, it; { return grab(type, it); }
 121: 
 122: #else
 123: 
 124: Visible value grab_tex(len) intlet len; { return grab(Tex, len); }
 125: 
 126: Visible value grab_elt() { return grab(ELT, 0); }
 127: 
 128: Visible value grab_lis(len) intlet len; { return grab(Lis, len); }
 129: 
 130: Visible value grab_tab(len) intlet len; { return grab(Tab, len); }
 131: 
 132: #endif
 133: 
 134: Visible value
 135: grab_num(len)
 136:     register int len;
 137: {
 138:     integer v;
 139:     register int i;
 140: 
 141:     if (len > Maxintlet) {
 142:         error(MESS(1804, "exceptionally large number"));
 143:         return Vnil;
 144:     }
 145:     if (len < -Maxintlet) len = -2;
 146:     v = (integer) grab(Num, len);
 147:     for (i = Length(v)-1; i >= 0; --i) Digit(v, i) = 0;
 148:     return (value) v;
 149: }
 150: 
 151: Visible value grab_rat() { return grab(Num, -2); }
 152: 
 153: Visible value
 154: regrab_num(v, len)
 155:     value v; register int len;
 156: {
 157:     register unsigned syze;
 158: 
 159:     syze = Len * sizeof(digit);
 160:     uniql(&v);
 161:     regetmem((ptr*)&v, Adj(syze));
 162:     Length(v) = len;
 163:     return v;
 164: }
 165: 
 166: Visible value grab_com(len) intlet len; { return grab(Com, len); }
 167: 
 168: Visible value grab_ptn(len) intlet len; { return grab(Ptn, len); }
 169: 
 170: Visible value grab_sim() { return grab(Sim, 0); }
 171: 
 172: Visible value grab_tri() { return grab(Tri, 0); }
 173: 
 174: Visible value grab_tse() { return grab(Tse, 0); }
 175: 
 176: Visible value grab_how() { return grab(How, 0); }
 177: 
 178: Visible value grab_for() { return grab(For, 0); }
 179: 
 180: Visible value grab_per() { return grab(Per, 0); }
 181: 
 182: Visible value grab_fun() { return grab(Fun, 0); }
 183: 
 184: Visible value grab_prd() { return grab(Prd, 0); }
 185: 
 186: Visible value grab_ref() { return grab(Ref, 0); }
 187: 
 188: #ifdef INTEGRATION
 189: 
 190: /*
 191:  * Allocate a node with nch children.
 192:  */
 193: 
 194: Visible node
 195: grab_node(nch)
 196:     register int nch;
 197: {
 198:     register node n = (node) grab(Nod, nch);
 199:     register int i;
 200: 
 201:     n->n_marks = 0;
 202:     n->n_width = 0;
 203:     n->n_symbol = 0;
 204:     for (i = nch-1; i >= 0; --i)
 205:         n->n_child[i] = Nnil;
 206:     return n;
 207: }
 208: 
 209: /*
 210:  * Allocate a path.
 211:  */
 212: 
 213: Visible path
 214: grab_path()
 215: {
 216:     register path p = (path) grab(Pat, 0);
 217: 
 218:     p->p_parent = PATHnil;
 219:     p->p_tree = Nnil;
 220:     p->p_ichild = 0;
 221:     p->p_ycoord = 0;
 222:     p->p_xcoord = 0;
 223:     p->p_level = 0;
 224:     p->p_addmarks = 0;
 225:     p->p_delmarks = 0;
 226:     return p;
 227: }
 228: 
 229: #endif INTEGRATION
 230: 
 231: 
 232: /******************************* Copying and releasing *********************/
 233: 
 234: Visible value
 235: copy(v)
 236:     value v;
 237: {
 238:     if (IsSmallInt(v)) return v;
 239:     if (v != Vnil && v->refcnt < Maxrefcnt) (v->refcnt)++;
 240: #ifdef NOT_USED
 241:  gr+=1;
 242: #endif
 243:     return v;
 244: }
 245: 
 246: Visible Procedure
 247: release(v)
 248:     value v;
 249: {
 250: #ifdef IBMPC
 251:     literal *r;
 252: #else
 253:     intlet *r;
 254: #endif
 255:     if (IsSmallInt(v)) return;
 256:     if (v == Vnil) return;
 257:     r= &(v->refcnt);
 258:     if (*r == 0) syserr(MESS(1805, "releasing unreferenced value"));
 259:     if (bugs) {
 260:         printf("releasing: ");
 261:         if (Type(v) == Num) bugs= No;
 262:         wri(v,No,No,No); newline();
 263:         bugs= Yes;
 264:     }
 265:     if (*r < Maxrefcnt && --(*r) == 0) rrelease(v);
 266: #ifdef NOT_USED
 267:  gr-=1;
 268: #endif
 269: }
 270: 
 271: Hidden value
 272: ccopy(v)
 273:     value v;
 274: {
 275:     literal type= v->type; intlet len; value w;
 276:     int nptrs; unsigned syze; register string from, to, end;
 277:     register value p, *pp, *pend;
 278:     len= Length(v);
 279:     syze= getsyze(type, len, &nptrs);
 280:     Grabber();
 281:     w= (value) getmem(Adj(syze));
 282:     w->type= type; w->len= len; w->refcnt= 1;
 283:     from= Str(v); to= Str(w); end= to+syze;
 284:     while (to < end) *to++ = *from++;
 285:     pp= Ats(w);
 286: #ifdef INTEGRATION
 287:     if (type == Nod) pp= (value*) ((char*)pp + NodOffset);
 288: #endif
 289:     pend= pp+nptrs;
 290:     while (pp < pend) {
 291:         p= *pp++;
 292:         if (p != Vnil && !IsSmallInt(p) && Refcnt(p) < Maxrefcnt)
 293:             ++Refcnt(p);
 294:     }
 295:     return w;
 296: }
 297: 
 298: Visible Procedure
 299: uniql(ll)
 300:     value *ll;
 301: {
 302:     if (*ll != Vnil && !IsSmallInt(*ll) && (*ll)->refcnt > 1) {
 303:         value c= ccopy(*ll);
 304:         release(*ll);
 305:         *ll= c;
 306:     }
 307: }
 308: 
 309: Hidden Procedure
 310: rrelease(v)
 311:     value v;
 312: {
 313:     literal type= v->type; intlet len;
 314:     int nptrs; register value *pp, *pend;
 315:     len= Length(v);
 316: #ifndef INTEGRATION
 317:     switch (type) {
 318:     case Tex:
 319:     case Tab:
 320:     case Lis:
 321:     case ELT:
 322:         relbtree(Root(v), Itemtype(v));
 323:         break;
 324:     default:
 325: #endif
 326:         VOID getsyze(type, len, &nptrs);
 327:         pp= Ats(v);
 328: #ifdef INTEGRATION
 329:         if (type == Nod) pp= (value*) ((char*)pp + NodOffset);
 330: #endif
 331:         pend= pp+nptrs;
 332:         while (pp < pend) release(*pp++);
 333: #ifndef INTEGRATION
 334:     }
 335: #endif
 336:     v->type= '\0'; freemem((ptr) v);
 337: }
 338: 
 339: #ifdef INTEGRATION
 340: 
 341: Visible Procedure
 342: xtndtex(a, d)
 343:     value *a; intlet d;
 344: {
 345:     intlet len= Length(*a)+d;
 346:     Regrabber();
 347:     regetmem((ptr *) a, Adj((len+1)*sizeof(char)));
 348:     (*a)->len= len;
 349: }
 350: 
 351: Visible Procedure
 352: xtndlt(a, d)
 353:     value *a; intlet d;
 354: {
 355:     intlet len= Length(*a); intlet l1= Len, l2;
 356:     len+= d; l2= Len;
 357:     if (l1 != l2) {
 358:         Regrabber();
 359:         regetmem((ptr *) a, Adj(l2*sizeof(value)));
 360:     }
 361:     (*a)->len= len;
 362: }
 363: 
 364: /*
 365:  * Set an object's refcnt to infinity, so it will never be released.
 366:  */
 367: 
 368: Visible Procedure
 369: fix_refcnt(v)
 370:     register value v;
 371: {
 372:     register int i;
 373:     register node n;
 374:     register path p;
 375: 
 376:     Assert(v->refcnt > 0);
 377:     v->refcnt = Maxrefcnt;
 378:     switch (v->type) {
 379:     case Tex:
 380:         break;
 381:     case Nod:
 382:         n = (node)v;
 383:         for (i = v->len - 1; i >= 0; --i)
 384:             if (n->n_child[i])
 385:                 fix_refcnt((value)(n->n_child[i]));
 386:         break;
 387:     case Pat:
 388:         p = (path)v;
 389:         if (p->p_parent)
 390:             fix_refcnt((value)(p->p_parent));
 391:         if (p->p_tree)
 392:             fix_refcnt((value)(p->p_tree));
 393:         break;
 394:     default:
 395:         Abort();
 396:     }
 397: }
 398: 
 399: #endif INTEGRATION
 400: 
 401: #ifndef INTEGRATION
 402: 
 403: /*********************************************************************/
 404: /* grab, copy, release of btree(node)s
 405: /*********************************************************************/
 406: 
 407: Visible btreeptr
 408: grabbtreenode(flag, it)
 409:     literal flag; literal it;
 410: {
 411:     btreeptr pnode; unsigned syz;
 412:     static intlet isize[]= {
 413:         sizeof(itexnode), sizeof(ilisnode),
 414:         sizeof(itabnode), sizeof(itabnode)};
 415:     static intlet bsize[]= {
 416:         sizeof(btexnode), sizeof(blisnode),
 417:         sizeof(btabnode), sizeof(btabnode)};
 418:     switch (flag) {
 419:     case Inner:
 420:         syz= isize[it];
 421:         break;
 422:     case Bottom:
 423:         syz= bsize[it];
 424:         break;
 425:     case Irange:
 426:     case Crange:
 427:         syz = sizeof(rangenode);
 428:         break;
 429:     }
 430:     pnode = (btreeptr) getmem((unsigned) syz);
 431:     Refcnt(pnode) = 1;
 432:     Flag(pnode) = flag;
 433:     return(pnode);
 434: }
 435: 
 436: /* ----------------------------------------------------------------- */
 437: 
 438: Visible btreeptr copybtree(pnode) btreeptr pnode; {
 439:     if (pnode != Bnil && Refcnt(pnode) < Maxrefcnt) ++Refcnt(pnode);
 440:     return(pnode);
 441: }
 442: 
 443: Visible Procedure uniqlbtreenode(pptr, it) btreeptr *pptr; literal it; {
 444:     if (*pptr NE Bnil && Refcnt(*pptr) > 1) {
 445:         btreeptr qnode = *pptr;
 446:         *pptr = ccopybtreenode(*pptr, it);
 447:         relbtree(qnode, it);
 448:     }
 449: }
 450: 
 451: Visible btreeptr ccopybtreenode(pnode, it) btreeptr pnode; literal it; {
 452:     intlet limp;
 453:     btreeptr qnode;
 454:     intlet iw;
 455: 
 456:     iw = Itemwidth(it);
 457:     qnode = grabbtreenode(Flag(pnode), it);
 458:     Lim(qnode) = limp = Lim(pnode);
 459:     Size(qnode) = Size(pnode);
 460:     switch (Flag(qnode)) {
 461:     case Inner:
 462:         cpynitms(Piitm(qnode, 0, iw), Piitm(pnode, 0, iw), limp, it);
 463:         cpynptrs(&Ptr(qnode, 0), &Ptr(pnode, 0), limp+1);
 464:         break;
 465:      case Bottom:
 466:         cpynitms(Pbitm(qnode, 0, iw), Pbitm(pnode, 0, iw), limp, it);
 467:         break;
 468:     case Irange:
 469:     case Crange:
 470:         Lwbval(qnode) = copy(Lwbval(pnode));
 471:         Upbval(qnode) = copy(Upbval(pnode));
 472:         break;
 473:     default:
 474:         syserr(MESS(1808, "unknown flag in ccopybtreenode"));
 475:     }
 476:     return(qnode);
 477: }
 478: 
 479: /* make a new root (after the old ptr0 split) */
 480: 
 481: Visible btreeptr mknewroot(ptr0, pitm0, ptr1, it)
 482:     btreeptr ptr0, ptr1; itemptr pitm0; literal it;
 483: {
 484:     int r;
 485:     intlet iw = Itemwidth(it);
 486:     btreeptr qnode = grabbtreenode(Inner, it);
 487:     Ptr(qnode, 0) = ptr0;
 488:     movnitms(Piitm(qnode, 0, iw), pitm0, 1, iw);
 489:     Ptr(qnode, 1) = ptr1;
 490:     Lim(qnode) = 1;
 491:     r= Sincr(Size(ptr0));
 492:     Size(qnode) = Ssum(r, Size(ptr1));
 493:     return(qnode);
 494: }
 495: 
 496: /* ----------------------------------------------------------------- */
 497: 
 498: /* release btree */
 499: 
 500: Visible Procedure relbtree(pnode, it) btreeptr pnode; literal it; {
 501:     width iw;
 502: 
 503:     iw = Itemwidth(it);
 504:     if (pnode EQ Bnil)
 505:         return;
 506:     if (Refcnt(pnode) EQ 0) {
 507:         syserr(MESS(1809, "releasing unreferenced btreenode"));
 508:         return;
 509:     }
 510:     if (Refcnt(pnode) < Maxrefcnt && --Refcnt(pnode) EQ 0) {
 511:         intlet l;
 512:         switch (Flag(pnode)) {
 513:         case Inner:
 514:             for (l = 0; l < Lim(pnode); l++) {
 515:                 relbtree(Ptr(pnode, l), it);
 516:                 switch (it) {
 517:                 case Tt:
 518:                 case Kt:
 519:                     release(Ascval(Piitm(pnode, l, iw)));
 520:                 case Lt:
 521:                     release(Keyval(Piitm(pnode, l, iw)));
 522:                 }
 523:             }
 524:             relbtree(Ptr(pnode, l), it);
 525:             break;
 526:         case Bottom:
 527:             for (l = 0; l < Lim(pnode); l++) {
 528:                 switch (it) {
 529:                 case Tt:
 530:                 case Kt:
 531:                     release(Ascval(Pbitm(pnode, l, iw)));
 532:                 case Lt:
 533:                     release(Keyval(Pbitm(pnode, l, iw)));
 534:                 }
 535:             }
 536:             break;
 537:         case Irange:
 538:         case Crange:
 539:             release(Lwbval(pnode));
 540:             release(Upbval(pnode));
 541:             break;
 542:         default:
 543:             syserr(MESS(1810, "wrong flag in relbtree()"));
 544:         }
 545:         freemem((ptr) pnode);
 546:     }
 547: }
 548: 
 549: #endif !INTEGRATION

Defined functions

ccopy defined in line 271; used 1 times
ccopybtreenode defined in line 451; used 2 times
copy defined in line 234; used 142 times
copybtree defined in line 438; used 4 times
fix_refcnt defined in line 368; used 3 times
getsyze defined in line 49; used 3 times
grab defined in line 103; used 20 times
grab_elt defined in line 126; used 2 times
grab_for defined in line 178; used 2 times
grab_fun defined in line 182; used 2 times
grab_how defined in line 176; used 2 times
grab_lis defined in line 128; used 6 times
grab_node defined in line 194; never used
grab_path defined in line 213; never used
grab_per defined in line 180; used 2 times
grab_prd defined in line 184; used 2 times
grab_ptn defined in line 168; used 2 times
grab_rat defined in line 151; used 6 times
grab_ref defined in line 186; used 2 times
grab_sim defined in line 170; used 2 times
grab_tex defined in line 124; used 9 times
grab_tri defined in line 172; used 2 times
grab_tse defined in line 174; used 2 times
prgr defined in line 46; never used
relbtree defined in line 500; used 6 times
release defined in line 246; used 466 times
rrelease defined in line 309; used 1 times
uniqlbtreenode defined in line 443; used 3 times
xtndlt defined in line 351; used 4 times
xtndtex defined in line 341; used 1 times

Defined variables

Visible defined in line 194; never used
gr defined in line 44; used 5 times
node defined in line 194; used 6 times

Defined macros

Adj defined in line 34; used 5 times
Grabber defined in line 38; used 2 times
Hdrsize defined in line 32; used 4 times
Len defined in line 29; used 5 times
NodOffset defined in line 36; used 2 times
Regrabber defined in line 39; used 2 times
Tsize defined in line 33; never used
Unadj defined in line 35; never used
Last modified: 1985-08-27
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 2902
Valid CSS Valid XHTML 1.0 Strict