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