|
|
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.