1: #include "../h/rt.h"
2: #include "../h/record.h"
3:
4: /*
5: * x[y] - access yth character or element of x.
6: */
7:
8: subsc(nargs, arg1v, arg2, arg1, arg0)
9: int nargs;
10: struct descrip arg1v, arg2, arg1, arg0;
11: {
12: register int i, j;
13: register union block *bp;
14: int typ1;
15: long l1;
16: struct descrip *dp;
17: char sbuf[MAXSTRING];
18: extern char *alcstr();
19: extern struct b_tvtbl *alctvtbl();
20:
21: SetBound;
22: /*
23: * Make a copy of x.
24: */
25: arg1v = arg1;
26:
27: if ((typ1 = cvstr(&arg1, sbuf)) != NULL) {
28: /*
29: * x is a string, make sure that y is an integer.
30: */
31: if (cvint(&arg2, &l1) == NULL)
32: runerr(101, &arg2);
33: /*
34: * Convert y to a position in x and fail if the position is out
35: * of bounds.
36: */
37: i = cvpos(l1, STRLEN(arg1));
38: if (i > STRLEN(arg1))
39: fail();
40: if (typ1 == 1) {
41: /*
42: * x was converted to a string, so it can't be assigned back into.
43: * Just return a string containing the selected character.
44: */
45: sneed(1);
46: STRLEN(arg0) = 1;
47: STRLOC(arg0) = alcstr(STRLOC(arg1)+i-1, 1);
48: }
49: else {
50: /*
51: * x is a string, make a substring trapped variable for the one
52: * character substring selected and return it.
53: */
54: hneed(sizeof(struct b_tvsubs));
55: mksubs(&arg1v, &arg1, i, 1, &arg0);
56: }
57: ClearBound;
58: return;
59: }
60:
61: /*
62: * x isn't a string or convertible to one, see if it's an aggregate.
63: */
64: DeRef(arg1)
65: switch (TYPE(arg1)) {
66: case T_LIST:
67: /*
68: * x is a list. Make sure that y is an integer and that the
69: * subscript is in range.
70: */
71: if (cvint(&arg2, &l1) == NULL)
72: runerr(101, &arg2);
73: i = cvpos(l1, BLKLOC(arg1)->list.cursize);
74: if (i > BLKLOC(arg1)->list.cursize)
75: fail();
76: /*
77: * Locate the list block containing the desired element.
78: */
79: bp = BLKLOC(BLKLOC(arg1)->list.listhead);
80: j = 1;
81: while (i >= j + bp->lelem.nused) {
82: j += bp->lelem.nused;
83: if (TYPE(bp->lelem.listnext) != T_LELEM)
84: syserr("list reference out of bounds in subsc");
85: bp = BLKLOC(bp->lelem.listnext);
86: }
87: /*
88: * Locate the desired element in the block that contains it and
89: * return a pointer to it.
90: */
91: i += bp->lelem.first - j;
92: if (i >= bp->lelem.nelem)
93: i -= bp->lelem.nelem;
94: dp = &bp->lelem.lslots[i];
95: arg0.type = D_VAR + ((int *)dp - (int *)bp);
96: VARLOC(arg0) = dp;
97: ClearBound;
98: return;
99:
100: case T_TABLE:
101: /*
102: * x is a table. Dereference y and locate the appropriate bucket
103: * based on the hash value.
104: */
105: DeRef(arg2)
106: hneed(sizeof(struct b_tvtbl));
107: i = hash(&arg2); /* get hash number of subscript */
108: bp = BLKLOC(BLKLOC(arg1)->table.buckets[i % NBUCKETS]);
109: /*
110: * Work down the chain of elements for the bucket and if an
111: * element with the desired subscript value is found, return
112: * a pointer to it.
113: * Elements are ordered in the chain by hashnumber value
114: * from smallest to largest.
115: */
116: while (bp != NULL) {
117: if (bp->telem.hashnum > i) /* past it - not there */
118: break;
119: if ((bp->telem.hashnum == i) && (equiv(&bp->telem.tref, &arg2))) {
120: dp = &bp->telem.tval;
121: arg0.type = D_VAR + ((int *)dp - (int *)bp);
122: VARLOC(arg0) = dp;
123: ClearBound;
124: return;
125: }
126: /* We haven't reached the right hashnumber yet or
127: * the element is not the right one.
128: */
129: bp = BLKLOC(bp->telem.blink);
130: }
131: /*
132: * x[y] is not in the table, make a table element trapped variable
133: * and return it as the result.
134: */
135: arg0.type = D_TVTBL;
136: BLKLOC(arg0) = (union block *) alctvtbl(&arg1, &arg2, i);
137: ClearBound;
138: return;
139:
140: case T_RECORD:
141: /*
142: * x is a record. Convert y to an integer and be sure that it
143: * it is in range as a field number.
144: */
145: if (cvint(&arg2, &l1) == NULL)
146: runerr(101, &arg2);
147: bp = BLKLOC(arg1);
148: i = cvpos(l1, bp->record.recptr->nfields);
149: if (i > bp->record.recptr->nfields)
150: fail();
151: /*
152: * Locate the appropriate field and return a pointer to it.
153: */
154: dp = &bp->record.fields[i-1];
155: arg0.type = D_VAR + ((int *)dp - (int *)bp);
156: VARLOC(arg0) = dp;
157: ClearBound;
158: return;
159:
160: default:
161: /*
162: * x is of a type that can't be subscripted.
163: */
164: runerr(114, &arg1);
165: }
166: ClearBound;
167: }
168:
169: Opblockx(subsc,3,"[]",2)
Defined functions
subsc
defined in line
8; used 1 times