Return to b1val.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint

Annotation of 43BSD/contrib/B/src/bint/b1val.c, revision 1.1

1.1     ! root        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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.