1: #include "../h/rt.h"
2: #include "../h/record.h"
3: #define randval (RSCALE*(k_random=(RANDA*k_random+RANDC)&MAXLONG))
4:
5: /*
6: * ?x - produce a randomly selected element of x.
7: */
8:
9: random(nargs, arg1v, arg1, arg0)
10: int nargs;
11: struct descrip arg1v, arg1, arg0;
12: {
13: register int val, i, j;
14: register union block *bp;
15: double r1;
16: char sbuf[MAXSTRING];
17: union block *ep;
18: struct descrip *dp;
19: extern char *alcstr();
20:
21: SetBound;
22: arg1v = arg1;
23: DeRef(arg1)
24:
25: /*
26: * x must not be null.
27: */
28: if (NULLDESC(arg1))
29: runerr(113, &arg1);
30:
31: if (QUAL(arg1)) {
32: /*
33: * x is a string, produce a random character in it as the result.
34: * Note that a substring trapped variable is returned.
35: */
36: if ((val = STRLEN(arg1)) <= 0)
37: fail();
38: hneed(sizeof(struct b_tvsubs));
39: mksubs(&arg1v, &arg1, (int)(randval*val)+1, 1, &arg0);
40: ClearBound;
41: return;
42: }
43:
44: switch (TYPE(arg1)) {
45: case T_CSET:
46: /*
47: * x is a cset. Convert it to a string, select a random character
48: * of that string and return it. Note that a substring trapped
49: * variable is not needed.
50: */
51: cvstr(&arg1, sbuf);
52: if ((val = STRLEN(arg1)) <= 0)
53: fail();
54: sneed(1);
55: STRLEN(arg0) = 1;
56: STRLOC(arg0) = alcstr(STRLOC(arg1)+(int)(randval*val), 1);
57: ClearBound;
58: return;
59:
60: case T_REAL:
61: /*
62: * x is real. Convert it to an integer and be sure that it is
63: * non-negative and less than MAXSHORT. Jump to common code
64: * to compute a random value. Note that reals are functionally
65: * equivalent to integers.
66: */
67: r1 = BLKLOC(arg1)->realblk.realval;
68: if (r1 < 0 || r1 > MAXSHORT)
69: runerr(205, &arg1);
70: val = (int)r1;
71: goto getrand;
72:
73: case T_INTEGER:
74: /*
75: * x is an integer, be sure that it's non-negative.
76: */
77: val = INTVAL(arg1);
78: if (val < 0)
79: runerr(205, &arg1);
80: getrand:
81: /*
82: * val contains the integer value of x. If val is 0, return
83: * a real in the range [0,1), else return an integer in the
84: * range [1,val].
85: */
86: if (val == 0)
87: mkreal(randval, &arg0);
88: else
89: mkint((long)(randval*val) + 1, &arg0);
90: ClearBound;
91: return;
92:
93: #ifdef LONGS
94: case T_LONGINT:
95: /*
96: * Produce an error if x is a long integer.
97: */
98: runerr(205, &arg1);
99: #endif LONGS
100: case T_LIST:
101: /*
102: * x is a list. Set i to a random number in the range [1,*x],
103: * failing if the list is empty.
104: */
105: bp = BLKLOC(arg1);
106: val = bp->list.cursize;
107: if (val <= 0)
108: fail();
109: i = (int)(randval*val) + 1;
110: j = 1;
111: /*
112: * Work down chain list of list blocks and find the block that
113: * contains the selected element.
114: */
115: bp = BLKLOC(BLKLOC(arg1)->list.listhead);
116: while (i >= j + bp->lelem.nused) {
117: j += bp->lelem.nused;
118: if (TYPE(bp->lelem.listnext) != T_LELEM)
119: syserr("list reference out of bounds in random");
120: bp = BLKLOC(bp->lelem.listnext);
121: }
122: /*
123: * Locate the appropriate element and return a variable
124: * that points to it.
125: */
126: i += bp->lelem.first - j;
127: if (i >= bp->lelem.nelem)
128: i -= bp->lelem.nelem;
129: dp = &bp->lelem.lslots[i];
130: arg0.type = D_VAR + ((int *)dp - (int *)bp);
131: VARLOC(arg0) = dp;
132: ClearBound;
133: return;
134:
135: case T_TABLE:
136: /*
137: * x is a table. Set i to a random number in the range [1,*x],
138: * failing if the table is empty.
139: */
140: bp = BLKLOC(arg1);
141: val = bp->table.cursize;
142: if (val <= 0)
143: fail();
144: i = (int)(randval*val) + 1;
145: /*
146: * Work down the chain of elements in each bucket and return
147: * a variable that points to the i'th element encountered.
148: */
149: for (j = 0; j < NBUCKETS; j++) {
150: for (ep = BLKLOC(bp->table.buckets[j]); ep != NULL;
151: ep = BLKLOC(ep->telem.blink)) {
152: if (--i <= 0) {
153: dp = &ep->telem.tval;
154: arg0.type = D_VAR + ((int *)dp - (int *)bp);
155: VARLOC(arg0) = dp;
156: ClearBound;
157: return;
158: }
159: }
160: }
161: #ifdef SETS
162: case T_SET:
163: /*
164: * x is a set. Set i to a random number in the range [1,*x],
165: * failing if the set is empty.
166: */
167: bp = BLKLOC(arg1);
168: val = bp->set.setsize;
169: if (val <= 0)
170: fail();
171: i = (int)(randval*val) + 1;
172: /*
173: * Work down the chain of elements in each bucket and return
174: * the value of the i'th element encountered.
175: */
176: for (j = 0; j < NBUCKETS; j++) {
177: for (ep = BLKLOC(bp->set.sbucks[j]); ep != NULL;
178: ep = BLKLOC(ep->selem.sblink)) {
179: if (--i <= 0) {
180: arg0 = ep->selem.setmem;
181: ClearBound;
182: return;
183: }
184: }
185: }
186: #endif SETS
187:
188: case T_RECORD:
189: /*
190: * x is a record. Set val to a random number in the range [1,*x]
191: * (*x is the number of fields), failing if the record has no
192: * fields.
193: */
194: bp = BLKLOC(arg1);
195: val = bp->record.recptr->nfields;
196: if (val <= 0)
197: fail();
198: /*
199: * Locate the selected element and return a variable
200: * that points to it
201: */
202: dp = &bp->record.fields[(int)(randval*val)];
203: arg0.type = D_VAR + ((int *)dp - (int *)bp);
204: VARLOC(arg0) = dp;
205: ClearBound;
206: return;
207:
208: default:
209: /*
210: * x is of a type for which there is no notion of elements.
211: */
212: runerr(113, &arg1);
213: }
214: }
215:
216: Opblockx(random,2,"?",1)
Defined functions
random
defined in line
9; used 1 times
Defined macros