![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to oref.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx|
Return to oref.c CVS log | Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx |
1.1 root 1: /*
2: * File: oref.c
3: * Contents: bang, sect, subsc
4: */
5:
6: #include "../h/rt.h"
7:
8: /*
9: * !x - generate successive values from object x.
10: */
11:
12: OpDclV(bang,1,"!")
13: {
14: register word i, j, slen;
15: register union block *bp, *ep;
16: register struct descrip *dp;
17: int typ1;
18: char sbuf[MaxCvtLen];
19: FILE *fd;
20: extern char *alcstr();
21:
22: Arg2 = Arg1;
23:
24: DeRef(Arg1);
25: if ((typ1 = cvstr(&Arg1, sbuf)) != NULL) {
26: /*
27: * A string is being banged.
28: */
29: i = 1;
30: while (i <= StrLen(Arg1)) {
31: /*
32: * Loop through the string using i as an index.
33: */
34: if (typ1 == Cvt) {
35: /*
36: * x was converted to a string, thus, the resulting string
37: * can't be modified and a trapped variable isn't needed.
38: * Make a one-character string out of the next character
39: * in x and suspend it.
40: */
41: strreq((word)1);
42: StrLen(Arg0) = 1;
43: StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, (word)1);
44: Suspend;
45: }
46: else {
47: /*
48: * x a string and thus a trapped variable must be made
49: * for the one character string being suspended.
50: */
51: blkreq((word)sizeof(struct b_tvsubs));
52: mksubs(&Arg2, &Arg1, i, (word)1, &Arg0);
53: Suspend;
54: Arg1 = Arg2;
55: DeRef(Arg1);
56: if (!Qual(Arg1))
57: runerr(103, &Arg1);
58: }
59: i++;
60: }
61: }
62: else {
63: /*
64: * x isn't a string.
65: */
66: switch (Type(Arg1)) {
67: case T_List:
68: /*
69: * x is a list. Chain through each list element block and for
70: * each one, suspend with a variable pointing to each
71: * element contained in the block.
72: */
73: bp = BlkLoc(Arg1);
74: for (Arg1 = bp->list.listhead; Arg1.dword == D_Lelem;
75: Arg1 = BlkLoc(Arg1)->lelem.listnext) {
76: bp = BlkLoc(Arg1);
77: for (i = 0; i < bp->lelem.nused; i++) {
78: j = bp->lelem.first + i;
79: if (j >= bp->lelem.nelem)
80: j -= bp->lelem.nelem;
81: dp = &bp->lelem.lslots[j];
82: Arg0.dword = D_Var + ((word *)dp - (word *)bp);
83: VarLoc(Arg0) = dp;
84: Suspend;
85: bp = BlkLoc(Arg1); /* bp is untended, must reset */
86: }
87: }
88: break;
89:
90:
91: case T_File:
92: /*
93: * x is a file. Read the next line into the string space
94: * and suspend the newly allocated string.
95: */
96: fd = BlkLoc(Arg1)->file.fd;
97: if ((BlkLoc(Arg1)->file.status & Fs_Read) == 0)
98: runerr(212, &Arg1);
99: while ((slen = getstr(sbuf,MaxCvtLen,fd)) >= 0) {
100: strreq(slen);
101: StrLen(Arg0) = slen;
102: StrLoc(Arg0) = alcstr(sbuf,slen);
103: Suspend;
104: }
105: break;
106:
107: case T_Table:
108: /*
109: * x is a table. Chain down the element list in each bucket
110: * and suspend a variable pointing to each element in turn.
111: */
112: for (i = 0; i < TSlots; i++) {
113: bp = BlkLoc(Arg1);
114: for (Arg2 = bp->table.buckets[i]; Arg2.dword == D_Telem;
115: Arg2 = BlkLoc(Arg2)->telem.clink) {
116: ep = BlkLoc(Arg2);
117: dp = &ep->telem.tval;
118: Arg0.dword = D_Var + ((word *)dp - (word *)ep);
119: VarLoc(Arg0) = dp;
120: Suspend;
121: bp = BlkLoc(Arg1); /* bp is untended, must reset */
122: }
123: }
124: break;
125:
126: case T_Set:
127: /*
128: * This is similar to the method for tables except that a
129: * value is returned instead of a variable.
130: */
131: for(i = 0; i < SSlots; i++) {
132: bp = BlkLoc(Arg1);
133: for(Arg2 = bp->set.sbucks[i]; Arg2.dword == D_Selem;
134: Arg2 = BlkLoc(Arg2)->selem.clink) {
135: Arg0 = BlkLoc(Arg2)->selem.setmem;
136: Suspend;
137: bp = BlkLoc(Arg1); /* bp untended, must be reset */
138: }
139: }
140: break;
141:
142: case T_Record:
143: /*
144: * x is a record. Loop through the fields and suspend
145: * a variable pointing to each one.
146: */
147: bp = BlkLoc(Arg1);
148: j = BlkLoc(bp->record.recdesc)->proc.nfields;
149: for (i = 0; i < j; i++) {
150: dp = &bp->record.fields[i];
151: Arg0.dword = D_Var + ((word *)dp - (word *)bp);
152: VarLoc(Arg0) = dp;
153: Suspend;
154: bp = BlkLoc(Arg1); /* bp is untended, must reset */
155: }
156: break;
157:
158: default: /* This object can not be compromised. */
159: runerr(116, &Arg1);
160: }
161: }
162:
163: /*
164: * Eventually fail.
165: */
166: Fail;
167: }
168:
169:
170: /*
171: * x[i:j] - form a substring or list section of x.
172: */
173:
174: OpDclV(sect,3,":")
175: {
176: register word i, j, t;
177: int typ1;
178: char sbuf[MaxCvtLen];
179: long l1, l2;
180: extern char *alcstr();
181:
182: blkreq((word)sizeof(struct b_tvsubs)); /* request space */
183:
184: if (cvint(&Arg2, &l1) == NULL)
185: runerr(101, &Arg2);
186: if (cvint(&Arg3, &l2) == NULL)
187: runerr(101, &Arg3);
188:
189: Arg4 = Arg1;
190: DeRef(Arg1);
191:
192: if (!Qual(Arg1) && Arg1.dword == D_List) {
193: i = cvpos(l1, BlkLoc(Arg1)->list.size);
194: if (i == 0)
195: Fail;
196: j = cvpos(l2, BlkLoc(Arg1)->list.size);
197: if (j == 0)
198: Fail;
199: if (i > j) {
200: t = i;
201: i = j;
202: j = t;
203: }
204: cplist(&Arg1, &Arg0, i, j);
205: Return;
206: }
207:
208: if ((typ1 = cvstr(&Arg1, sbuf)) == NULL)
209: runerr(110, &Arg1);
210:
211: i = cvpos(l1, StrLen(Arg1));
212: if (i == 0)
213: Fail;
214: j = cvpos(l2, StrLen(Arg1));
215: if (j == 0)
216: Fail;
217: if (i > j) { /* convert section to substring */
218: t = i;
219: i = j;
220: j = t - j;
221: }
222: else
223: j = j - i;
224:
225: if (typ1 == Cvt) { /* if string was created, */
226: strreq(j); /* just return a string */
227: StrLen(Arg0) = j;
228: StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, j);
229: }
230: else /* else make a substring tv */
231: mksubs(&Arg4, &Arg1, i, j, &Arg0);
232: Return;
233: }
234:
235:
236: /*
237: * x[y] - access yth character or element of x.
238: */
239:
240: OpDclV(subsc,2,"[]")
241: {
242: register word i, j;
243: register union block *bp;
244: int typ1;
245: long l1;
246: struct descrip *dp;
247: char sbuf[MaxCvtLen];
248: extern char *alcstr();
249: extern struct b_tvtbl *alctvtbl();
250:
251: /*
252: * Make a copy of x.
253: */
254: Arg3 = Arg1;
255:
256: DeRef(Arg1);
257: if ((typ1 = cvstr(&Arg1, sbuf)) != NULL) {
258: /*
259: * x is a string, make sure that y is an integer.
260: */
261: if (cvint(&Arg2, &l1) == NULL)
262: runerr(101, &Arg2);
263: /*
264: * Convert y to a position in x and fail if the position is out
265: * of bounds.
266: */
267: i = cvpos(l1, StrLen(Arg1));
268: if (i == 0 || i > StrLen(Arg1))
269: Fail;
270: if (typ1 == Cvt) {
271: /*
272: * x was converted to a string, so it can't be assigned back into.
273: * Just return a string containing the selected character.
274: */
275: strreq((word)1);
276: StrLen(Arg0) = 1;
277: StrLoc(Arg0) = alcstr(StrLoc(Arg1)+i-1, (word)1);
278: }
279: else {
280: /*
281: * x is a string, make a substring trapped variable for the one
282: * character substring selected and return it.
283: */
284: blkreq((word)sizeof(struct b_tvsubs));
285: mksubs(&Arg3, &Arg1, i, (word)1, &Arg0);
286: }
287: Return;
288: }
289:
290: /*
291: * x isn't a string or convertible to one, see if it's an aggregate.
292: */
293: DeRef(Arg1);
294: /* >listref */
295: switch (Type(Arg1)) {
296: case T_List:
297: /*
298: * Make sure that Arg2 is an integer and that the
299: * subscript is in range.
300: */
301: if (cvint(&Arg2, &l1) == NULL)
302: runerr(101, &Arg2);
303: i = cvpos(l1, BlkLoc(Arg1)->list.size);
304: if (i == 0 || i > BlkLoc(Arg1)->list.size)
305: Fail;
306:
307: /*
308: * Locate the list block containing the desired element.
309: */
310: bp = BlkLoc(BlkLoc(Arg1)->list.listhead);
311: j = 1;
312: while (i >= j + bp->lelem.nused) {
313: j += bp->lelem.nused;
314: if ((bp->lelem.listnext).dword != D_Lelem)
315: syserr("list reference out of bounds in subsc");
316: bp = BlkLoc(bp->lelem.listnext);
317: }
318:
319: /*
320: * Locate the desired element in the block that contains it
321: * and return a pointer to it.
322: */
323: i += bp->lelem.first - j;
324: if (i >= bp->lelem.nelem)
325: i -= bp->lelem.nelem;
326: dp = &bp->lelem.lslots[i];
327: Arg0.dword = D_Var + ((int *)dp - (int *)bp);
328: VarLoc(Arg0) = dp;
329: Return;
330: /* <listref */
331:
332: case T_Table:
333: /*
334: * x is a table. Locate the appropriate bucket
335: * based on the hash value.
336: */
337: blkreq((word)sizeof(struct b_tvtbl));
338: i = hash(&Arg2); /* get hash number of subscript */
339: bp = BlkLoc(BlkLoc(Arg1)->table.buckets[SlotNum(i,TSlots)]);
340: /*
341: * Work down the chain of elements for the bucket and if an
342: * element with the desired subscript value is found, return
343: * a pointer to it.
344: * Elements are ordered in the chain by hash number value
345: * from smallest to largest.
346: */
347: while (bp != NULL) {
348: if (bp->telem.hashnum > i) /* past it - not there */
349: break;
350: if ((bp->telem.hashnum == i) && (equiv(&bp->telem.tref, &Arg2))) {
351: dp = &bp->telem.tval;
352: Arg0.dword = D_Var + ((word *)dp - (word *)bp);
353: VarLoc(Arg0) = dp;
354: Return;
355: }
356: /* We haven't reached the right hash number yet or
357: * the element is not the right one.
358: */
359: bp = BlkLoc(bp->telem.clink);
360: }
361: /*
362: * x[y] is not in the table, make a table element trapped variable
363: * and return it as the result.
364: */
365: Arg0.dword = D_Tvtbl;
366: BlkLoc(Arg0) = (union block *) alctvtbl(&Arg1, &Arg2, i);
367: Return;
368:
369: case T_Record:
370: /*
371: * x is a record. Convert y to an integer and be sure that it
372: * it is in range as a field number.
373: */
374: if (cvint(&Arg2, &l1) == NULL)
375: runerr(101, &Arg2);
376: bp = BlkLoc(Arg1);
377: i = cvpos(l1, (word)(BlkLoc(bp->record.recdesc)->proc.nfields));
378: if (i == 0 || i > BlkLoc(bp->record.recdesc)->proc.nfields)
379: Fail;
380: /*
381: * Locate the appropriate field and return a pointer to it.
382: */
383: dp = &bp->record.fields[i-1];
384: Arg0.dword = D_Var + ((word *)dp - (word *)bp);
385: VarLoc(Arg0) = dp;
386: Return;
387:
388: default:
389: /*
390: * x is of a type that can't be subscripted.
391: */
392: runerr(114, &Arg1);
393: }
394: Return;
395: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.