![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to fconv.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 fconv.c CVS log | Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx |
1.1 root 1: /*
2: * File: fconv.c
3: * Contents: abs, cset, integer, list, numeric, proc, real, set, string, table
4: */
5:
6: #include "../h/rt.h"
7:
8: /*
9: * abs(x) - absolute value of x.
10: */
11: FncDcl(abs,1)
12: {
13: union numeric result;
14:
15: switch (cvnum(&Arg1, &result)) {
16: /*
17: * If x is convertible to a numeric, turn Arg0 into
18: * a descriptor for the appropriate type and value. If the
19: * conversion fails, produce an error. This code assumes that
20: * x = -x is always valid, but this assumption does not always
21: * hold.
22: */
23: case T_Integer:
24: case T_Longint:
25: if (result.integer < 0L)
26: result.integer = -result.integer;
27: Mkint(result.integer, &Arg0);
28: break;
29:
30: case T_Real:
31: if (result.real < 0.0)
32: result.real = -result.real;
33: mkreal(result.real, &Arg0);
34: break;
35:
36: default:
37: runerr(102, &Arg1);
38: }
39: Return;
40: }
41:
42:
43: /*
44: * cset(x) - convert x to cset.
45: */
46:
47: FncDcl(cset,1)
48: {
49: register int i, j;
50: register struct b_cset *bp;
51: int *cs, csbuf[CsetSize];
52: extern struct b_cset *alccset();
53:
54: blkreq((word)sizeof(struct b_cset));
55:
56: if (Arg1.dword == D_Cset)
57: /*
58: * x is already a cset, just return it.
59: */
60: Arg0 = Arg1;
61: else if (cvcset(&Arg1, &cs, csbuf) != NULL) {
62: /*
63: * x was convertible to cset and the result resides in csbuf. Allocate
64: * a cset, make Arg0 a descriptor for it and copy the bits from csbuf
65: * into it.
66: */
67: Arg0.dword = D_Cset;
68: bp = alccset(0);
69: BlkLoc(Arg0) = (union block *) bp;
70: for (i = 0; i < CsetSize; i++)
71: bp->bits[i] = cs[i];
72: j = 0;
73: for (i = 0; i < CsetSize*CIntSize; i++) {
74: if (Testb(i,cs))
75: j++;
76: }
77: bp->size = j;
78: }
79: else /* Not a cset nor convertible to one. */
80: Fail;
81: Return;
82: }
83:
84:
85: /*
86: * integer(x) - convert x to integer.
87: */
88:
89: FncDcl(integer,1)
90: {
91: long l;
92:
93: switch (cvint(&Arg1, &l)) {
94:
95: case T_Integer:
96: case T_Longint:
97: Mkint(l, &Arg0);
98: break;
99:
100: default:
101: Fail;
102: }
103: Return;
104: }
105:
106:
107: /*
108: * list(n,x) - create a list of size n, with initial value x.
109: */
110:
111: /* >list */
112: FncDcl(list,2)
113: {
114: register word i, size;
115: word nelem;
116: register struct b_lelem *bp;
117: register struct b_list *hp;
118: extern struct b_list *alclist();
119: extern struct b_lelem *alclstb();
120:
121: defshort(&Arg1, 0); /* Size defaults to 0 */
122:
123: nelem = size = IntVal(Arg1);
124:
125:
126: /*
127: * Ensure that the size is positive and that the list element block
128: * has at least MinListSlots element slots.
129: */
130: if (size < 0)
131: runerr(205, &Arg1);
132: if (nelem < MinListSlots)
133: nelem = MinListSlots;
134:
135: /*
136: * Ensure space for a list header block, and a list element block
137: * with nelem element slots.
138: */
139: blkreq(sizeof(struct b_list) + sizeof(struct b_lelem) +
140: nelem * sizeof(struct descrip));
141:
142: /*
143: * Allocate the list header block and a list element block.
144: * Note that nelem is the number of elements in the list element
145: * block while size is the number of elements in the
146: * list.
147: */
148: hp = alclist(size);
149: bp = alclstb(nelem, (word)0, size);
150: hp->listhead.dword = hp->listtail.dword = D_Lelem;
151: BlkLoc(hp->listhead) = BlkLoc(hp->listtail) = (union block *) bp;
152:
153: /*
154: * Initialize each list element.
155: */
156: for (i = 0; i < size; i++)
157: bp->lslots[i] = Arg2;
158:
159: /*
160: * Return the new list.
161: */
162: Arg0.dword = D_List;
163: BlkLoc(Arg0) = (union block *) hp;
164: Return;
165: }
166: /* <list */
167:
168:
169: /*
170: * numeric(x) - convert x to numeric type.
171: */
172: FncDcl(numeric,1)
173: {
174: union numeric n1;
175:
176: switch (cvnum(&Arg1, &n1)) {
177:
178: case T_Integer:
179: case T_Longint:
180: Mkint(n1.integer, &Arg0);
181: break;
182:
183: case T_Real:
184: mkreal(n1.real, &Arg0);
185: break;
186:
187: default:
188: Fail;
189: }
190: Return;
191: }
192:
193:
194: /*
195: * proc(x,args) - convert x to a procedure if possible; use args to
196: * resolve ambiguous string names.
197: */
198: FncDcl(proc,2)
199: {
200: char sbuf[MaxCvtLen];
201:
202: /*
203: * If x is already a proc, just return it in Arg0.
204: */
205: Arg0 = Arg1;
206: if (Arg0.dword == D_Proc) {
207: Return;
208: }
209: if (cvstr(&Arg0, sbuf) == NULL)
210: Fail;
211: /*
212: * args defaults to 1.
213: */
214: defshort(&Arg2, 1);
215: /*
216: * Attempt to convert Arg0 to a procedure descriptor using args to
217: * discriminate between procedures with the same names. Fail if
218: * the conversion isn't successful.
219: */
220: if (strprc(&Arg0,IntVal(Arg2))) {
221: Return;
222: }
223: else
224: Fail;
225: }
226:
227:
228: /*
229: * real(x) - convert x to real.
230: */
231:
232: FncDcl(real,1)
233: {
234: double r;
235:
236: /*
237: * If x is already a real, just return it. Otherwise convert it and
238: * return it, failing if the conversion is unsuccessful.
239: */
240: if (Arg1.dword == D_Real)
241: Arg0 = Arg1;
242: else if (cvreal(&Arg1, &r) == T_Real)
243: mkreal(r, &Arg0);
244: else
245: Fail;
246: Return;
247: }
248:
249:
250: /*
251: * set(list) - create a set with members in list.
252: * The members are linked into hash chains which are
253: * arranged in increasing order by hash number.
254: */
255: FncDcl(set,1)
256: {
257: register word hn;
258: register struct descrip *pd;
259: register struct b_set *ps;
260: union block *pb;
261: struct b_selem *ne;
262: struct descrip *pe;
263: int res;
264: word i, j;
265: extern struct descrip *memb();
266: extern struct b_set *alcset();
267: extern struct b_selem *alcselem();
268:
269: if (Arg1.dword != D_List)
270: runerr(108,&Arg1);
271:
272: blkreq(sizeof(struct b_set) + (BlkLoc(Arg1)->list.size *
273: sizeof(struct b_selem)));
274:
275: pb = BlkLoc(Arg1);
276: Arg0.dword = D_Set;
277: ps = alcset();
278: BlkLoc(Arg0) = (union block *) ps;
279: /*
280: * Chain through each list block and for
281: * each element contained in the block
282: * insert the element into the set if not there.
283: */
284: for (Arg1 = pb->list.listhead; Arg1.dword == D_Lelem;
285: Arg1 = BlkLoc(Arg1)->lelem.listnext) {
286: pb = BlkLoc(Arg1);
287: for (i = 0; i < pb->lelem.nused; i++) {
288: j = pb->lelem.first + i;
289: if (j >= pb->lelem.nelem)
290: j -= pb->lelem.nelem;
291: pd = &pb->lelem.lslots[j];
292: pe = memb(ps, pd, hn = hash(pd), &res);
293: if (res == 0) {
294: ne = alcselem(pd,hn);
295: addmem(ps,ne,pe);
296: }
297: }
298: }
299: Return;
300: }
301:
302:
303: /*
304: * string(x) - convert x to string.
305: */
306:
307: /* >string */
308: FncDcl(string,1)
309: {
310: char sbuf[MaxCvtLen];
311: extern char *alcstr();
312:
313: Arg0 = Arg1;
314: switch (cvstr(&Arg0, sbuf)) {
315:
316: /*
317: * If Arg1 is not a string, allocate it and return it; if it is a
318: * string, just return it; fail otherwise.
319: */
320: case Cvt:
321: strreq(StrLen(Arg0)); /* allocate converted string */
322: StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
323:
324: case NoCvt:
325: Return;
326:
327: default:
328: Fail;
329: }
330: }
331: /* <string */
332:
333: /*
334: * table(x) - create a table with default value x.
335: */
336: FncDcl(table,1)
337: {
338: extern struct b_table *alctable();
339:
340: blkreq((word)sizeof(struct b_table));
341: Arg0.dword = D_Table;
342: BlkLoc(Arg0) = (union block *) alctable(&Arg1);
343: Return;
344: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.