![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to stack.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / basic / bas|
Return to stack.c CVS log | Up to [Research Unix] / researchv10no / cmd / basic / bas |
1.1 root 1: #include <stdio.h>
2: #include "ctype.h"
3: #include "typedef.h"
4: #include "basic.h"
5:
6: #define GCHDRSIZE (sizeof(struct strarea))
7: #define TYPEMASK 017
8: #define gchdr(p) ((struct strarea *)(p))
9:
10: struct strarea {
11: unsigned x_len;
12: String *x_next;
13: };
14:
15: static char *typenames[] = {
16: "", "integer", "real", "string", "", "function", "for", "gosub",
17: "any expression", "integer expression", "real expression",
18: "string expression", "", "", "", ""
19: };
20:
21: double popfloat();
22: Stkptr push(), pop(), nextframe();
23: char *allocstr();
24:
25:
26: /*
27: * push --- push frame pointed to by sp onto stack
28: */
29:
30: Stkptr push(sp)
31: Stkptr sp;
32: {
33: register Stkptr p;
34: register char *s;
35:
36: p = sp;
37: s = stkptr - p->k_len;
38: if (s < stkbase)
39: err("stack overflow");
40: if (tflg) {
41: register int i;
42:
43: fprintf(stderr, "push: type %d, length %d:",
44: p->k_type, p->k_len);
45: for (i = 0; i < p->k_len; ++i)
46: fprintf(stderr, " %o", ((char *)sp)[i]&0377);
47: putc('\n', stderr);
48: }
49: move(p->k_len, p, s);
50: stkptr = (char *)s;
51: return ((Stkptr)s);
52: }
53:
54:
55: /*
56: * clrstk --- reinitialize the stack pointer
57: */
58:
59: clrstk()
60: {
61: stkptr = stktop;
62: *stkptr-- = 0; /* k_len = 0 */
63: *stkptr = 0; /* k_type = 0 */
64: restore();
65: }
66:
67:
68: /*
69: * restore --- reset the DATA pointer to the beginning
70: */
71:
72: restore()
73: {
74:
75: data.k_un.k_gosub.g_inptr = NULL;
76: data.k_un.k_gosub.g_curline = (Linep)lines;
77: }
78:
79:
80: /*
81: * pop --- pop the top frame off the stack and return a pointer to it;
82: * check that the frame is of the specified type
83: */
84:
85: Stkptr pop(type)
86: {
87: register Stkptr s;
88: register int i;
89:
90: s = (Stkptr)stkptr;
91: if (s->k_type == 0)
92: badstk(0);
93: if (tflg) {
94: fprintf(stderr, "pop: type %d, length %d",
95: s->k_type, s->k_len);
96: for (i = 0; i < s->k_len; ++i)
97: fprintf(stderr, " %o", ((char *)s)[i]&0377);
98: putc('\n', stderr);
99: }
100: if (s->k_type != type && type != ANYTYPE)
101: badstk(type);
102: stkptr += s->k_len;
103: return (s);
104: }
105:
106:
107: /*
108: * pushstring --- push a string onto the stack
109: */
110:
111: Stkptr pushstring(ptr, len)
112: char *ptr;
113: {
114: Stkfr s;
115:
116: s.k_type = STRINGEXPR;
117: s.k_len = STRFRLEN;
118: s.k_un.k_str.s_ptr = ptr;
119: s.k_un.k_str.s_len = len;
120: return (push(&s));
121: }
122:
123:
124: /*
125: * pushfloat --- push a floating point value onto the stack
126: */
127:
128: Stkptr pushfloat(f)
129: double f;
130: {
131: register Stkptr s;
132: Stkfr fe;
133:
134: s = (Stkptr)(stkptr - DBLFRLEN);
135: if ((char *)s < stkbase)
136: badstk(0);
137: if (tflg)
138: fprintf(stderr, "pushfloat: %f\n", f);
139: stkptr = (char *)s;
140: s->k_type = FLOATEXPR;
141: s->k_len = DBLFRLEN;
142: s->k_un.k_dbl = f;
143: return (s);
144: }
145:
146:
147: /*
148: * popfloat --- pop a floating point value off the stack
149: */
150:
151: double popfloat()
152: {
153: register Stkptr s;
154:
155: s = (Stkptr)stkptr;
156: if (s->k_type != FLOATEXPR)
157: badstk(FLOATEXPR);
158: if (tflg)
159: fprintf(stderr, "popfloat: %f\n", s->k_un.k_dbl);
160: stkptr += s->k_len;
161: return (s->k_un.k_dbl);
162: }
163:
164:
165: /*
166: * badstk --- report a bad stack frame
167: */
168:
169: badstk(type)
170: {
171: register int i;
172:
173: if ((i = ((Stkptr)stkptr)->k_type) == 0)
174: err("stack underflow");
175: if (type)
176: err("%s value or variable expected; got %s",
177: typenames[type & 07], typenames[i & 07]);
178: err("bad stack frame");
179: }
180:
181:
182: #ifndef popint
183: /*
184: * popint --- pop an integer value off the stack
185: */
186:
187: popint()
188: {
189:
190: return ((int)popfloat());
191: }
192: #endif
193:
194:
195: /*
196: * popstring --- pop a string off the stack
197: */
198:
199: popstring(sptr, lptr)
200: char **sptr;
201: int *lptr;
202: {
203: register Stkptr s;
204:
205: s = pop(STRINGEXPR);
206: *sptr = s->k_un.k_str.s_ptr;
207: *lptr = s->k_un.k_str.s_len;
208: }
209:
210:
211: /*
212: * allocstr --- allocate and copy string into string space;
213: */
214:
215: char *allocstr(ptr, len, mlen)
216: char *ptr;
217: {
218: register char *s;
219: register int l;
220:
221: l = len + GCHDRSIZE;
222: if (l & 1)
223: ++l; /* make it even */
224: if (strptr + l >= endstring)
225: collect();
226: s = strptr;
227: strptr += l;
228: gchdr(s)->x_len = len;
229: gchdr(s)->x_next = (String *)NULL;
230: s += GCHDRSIZE;
231: if (mlen)
232: move(mlen, ptr, s);
233: return (s);
234: }
235:
236:
237: /*
238: * collect --- collect garbage in string space
239: */
240:
241: collect()
242: {
243: register Symptr s;
244: register Stkptr k;
245: register char *p, *q;
246: register int l, n;
247: String *sp, *tsp;
248:
249: for (s = chains[0][STRING]; s; s = s->v_next) {
250: if (tflg)
251: fprintf(stderr, "mark var %.2s ", s->v_name);
252: mark(&s->v_un.v_str, 1);
253: }
254: for (s = chains[1][STRING]; s; s = s->v_next) {
255: if (tflg)
256: fprintf(stderr, "mark vec %.2s ", s->v_name);
257: for (n = 1, l = s->v_nsubs; --l >= 0; )
258: n *= s->v_un.v_vec.v_subsc[l];
259: mark(s->v_un.v_vec.v_vecun.v_strvec, n);
260: }
261: for (k = (Stkptr)stkptr; k->k_type; k = nextframe(k))
262: if (k->k_type == STRINGEXPR) {
263: if (tflg)
264: fprintf(stderr, "mark stk %X ", k);
265: mark(&k->k_un.k_str, 1); /* mark stack frame */
266: }
267: for (q = p = strspace; p < strptr; p += l) {
268: if ((sp = gchdr(p)->x_next) == (String *)NULL) {
269: l = gchdr(p)->x_len + GCHDRSIZE;
270: if (l & 1)
271: ++l;
272: }
273: else {
274: l = sp->s_len + GCHDRSIZE;
275: if (l & 1)
276: ++l;
277: if (p != q) {
278: move(l, p, q);
279: if (tflg)
280: fprintf(stderr, "move %l %X %X\n",
281: l, p, q);
282: }
283: gchdr(q)->x_len = sp->s_len;
284: gchdr(q)->x_next = (String *)NULL;
285: for (; sp != (String *)NULL; sp = tsp) {
286: tsp = (String *)sp->s_ptr;
287: sp->s_ptr = q + GCHDRSIZE;
288: if (tflg)
289: fprintf(stderr, "reset %X = %X %d\n",
290: sp, sp->s_ptr, sp->s_len);
291: }
292: q += l;
293: }
294: }
295: l = endstring - q; /* amount now free */
296: if (tflg)
297: fprintf(stderr, "%d bytes recovered\n", l);
298: strptr = q;
299: if (l < MAXSTRSPACE / 10)
300: err("not enough free space");
301: }
302:
303:
304: /*
305: * mark --- mark a string as being used
306: * this is accomplished by storing a pointer to the
307: * String structure referring to this string in the
308: * x_next field of the string header.
309: * multiple references to the same string are linked
310: * together through the s_ptr field of the String structures.
311: */
312:
313: mark(ptr, n)
314: String *ptr;
315: {
316: String *s;
317: register char *p;
318:
319: for (s = ptr; --n >= 0; ++s) {
320: p = s->s_ptr;
321: if (isstring(p)) {
322: p -= GCHDRSIZE; /* point to GC header */
323: if (tflg)
324: fprintf(stderr, "mark %X %d\n", p, s->s_len);
325: if (s->s_len != gchdr(p)->x_len)
326: err("bad string list");
327: s->s_ptr = (char *)gchdr(p)->x_next;
328: gchdr(p)->x_next = s;
329: }
330: }
331: }
332:
333:
334: /*
335: * storestring --- store string at top of stack
336: */
337:
338: storestring(v)
339: String *v;
340: {
341: /*
342: * the old value of the variable is changed last, so that in the
343: * case of an error, it is still available, allowing re-execution
344: * of the line with the error.
345: * if storing a pointer will suffice (a$ = b$)
346: * then only store the pointer, otherwise allocate more space
347: * and copy the string.
348: */
349: register char *ptr;
350: register int len;
351: register Stkptr s;
352:
353: s = (Stkptr)stkptr;
354: len = s->k_un.k_str.s_len;
355: ptr = s->k_un.k_str.s_ptr;
356: if (!isstring(ptr)
357: || ((unsigned)ptr&1) != 0
358: || gchdr(ptr - GCHDRSIZE)->x_len != len) {
359: ptr = allocstr(NULL, len, 0); /* alloc but don't copy */
360: move(len, s->k_un.k_str.s_ptr, ptr);
361: }
362: v->s_ptr = ptr;
363: v->s_len = len;
364: pop(STRINGEXPR);
365: }
366:
367:
368: /*
369: * nextframe --- return ptr to frame after one pointed to by sp
370: */
371:
372: Stkptr nextframe(sp)
373: register Stkptr sp;
374: {
375:
376: return ((Stkptr)((char *)sp + sp->k_len));
377: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.