Return to B1val.c CVS log

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

Annotation of 43BSD/contrib/B/src/bsmall/B1val.c, revision 1.1

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

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