![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to image.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / icon / functions|
Return to image.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / icon / functions |
1.1 root 1: #include "../h/rt.h"
2: #include "../h/record.h"
3:
4: /*
5: * image(x) - return string image of object x. Nothing fancy here,
6: * just plug and chug on a case-wise basis.
7: */
8:
9: Ximage(nargs, arg1, arg0)
10: int nargs;
11: struct descrip arg1, arg0;
12: {
13: register int len, outlen, rnlen;
14: register char *s;
15: register union block *bp;
16: char *type;
17: extern char *alcstr();
18: extern struct descrip *cstos();
19: char sbuf[MAXSTRING];
20: FILE *fd;
21:
22: DeRef(arg1)
23:
24: if (NULLDESC(arg1)) { /* &null */
25: STRLOC(arg0) = "&null";
26: STRLEN(arg0) = 5;
27: return;
28: }
29:
30: if (QUAL(arg1)) {
31: /*
32: * Get some string space. The magic 2 is for the double quote at each
33: * end of the resulting string.
34: */
35: sneed(prescan(&arg1) + 2);
36: len = STRLEN(arg1);
37: s = STRLOC(arg1);
38: outlen = 2;
39: /*
40: * Form the image by putting a " in the string space, calling
41: * doimage with each character in the string, and then putting
42: * a " at then end. Note that doimage directly writes into the
43: * string space. (Hence the indentation.) This techinique is used
44: * several times in this routine.
45: */
46: STRLOC(arg0) = alcstr("\"", 1);
47: while (len-- > 0)
48: outlen += doimage(*s++, '"');
49: alcstr("\"", 1);
50: STRLEN(arg0) = outlen;
51: return;
52: }
53:
54: switch (TYPE(arg1)) {
55: case T_INTEGER:
56: #ifdef LONGS
57: case T_LONGINT:
58: #endif LONGS
59: case T_REAL:
60: /*
61: * Form a string representing the number and allocate it.
62: */
63: cvstr(&arg1, sbuf);
64: len = STRLEN(arg1);
65: sneed(len);
66: STRLOC(arg0) = alcstr(STRLOC(arg1), len);
67: STRLEN(arg0) = len;
68: return;
69:
70: case T_CSET:
71: /*
72: * Check for distinguished csets by looking at the address of
73: * of the object to image. If one is found, make a string
74: * naming it and return.
75: */
76: if (BLKLOC(arg1) == ((union block *) &k_ascii)) {
77: STRLOC(arg0) = "&ascii";
78: STRLEN(arg0) = 6;
79: return;
80: }
81: else if (BLKLOC(arg1) == ((union block *) &k_cset)) {
82: STRLOC(arg0) = "&cset";
83: STRLEN(arg0) = 5;
84: return;
85: }
86: else if (BLKLOC(arg1) == ((union block *) &k_lcase)) {
87: STRLOC(arg0) = "&lcase";
88: STRLEN(arg0) = 6;
89: return;
90: }
91: else if (BLKLOC(arg1) == ((union block *) &k_ucase)) {
92: STRLOC(arg0) = "&ucase";
93: STRLEN(arg0) = 6;
94: return;
95: }
96: /*
97: * Convert the cset to a string and proceed as is done for
98: * string images but use a ' rather than " to bound the
99: * result string.
100: */
101: cvstr(&arg1, sbuf);
102: sneed(prescan(&arg1) + 2);
103: len = STRLEN(arg1);
104: s = STRLOC(arg1);
105: outlen = 2;
106: STRLOC(arg0) = alcstr("'", 1);
107: while (len-- > 0)
108: outlen += doimage(*s++, '\'');
109: alcstr("'", 1);
110: STRLEN(arg0) = outlen;
111: return;
112:
113: case T_FILE:
114: /*
115: * Check for distinguished files by looking at the address of
116: * of the object to image. If one is found, make a string
117: * naming it and return.
118: */
119: if ((fd = BLKLOC(arg1)->file.fd) == stdin) {
120: STRLEN(arg0) = 6;
121: STRLOC(arg0) = "&input";
122: }
123: else if (fd == stdout) {
124: STRLEN(arg0) = 7;
125: STRLOC(arg0) = "&output";
126: }
127: else if (fd == stderr) {
128: STRLEN(arg0) = 7;
129: STRLOC(arg0) = "&errout";
130: }
131: else {
132: /*
133: * The file is not a standard one, form a string of the form
134: * file(nm) where nm is the argument originally given to
135: * open.
136: */
137: sneed(prescan(&BLKLOC(arg1)->file.fname)+6);
138: len = STRLEN(BLKLOC(arg1)->file.fname);
139: s = STRLOC(BLKLOC(arg1)->file.fname);
140: outlen = 6;
141: STRLOC(arg0) = alcstr("file(", 5);
142: while (len-- > 0)
143: outlen += doimage(*s++, '\0');
144: alcstr(")", 1);
145: STRLEN(arg0) = outlen;
146: }
147: return;
148:
149: case T_PROC:
150: /*
151: * Produce one of:
152: * "procedure name"
153: * "function name"
154: * "record constructor name"
155: *
156: * Note that the number of dynamic locals is used to determine
157: * what type of "procedure" is at hand.
158: */
159: len = STRLEN(BLKLOC(arg1)->proc.pname);
160: s = STRLOC(BLKLOC(arg1)->proc.pname);
161: switch (BLKLOC(arg1)->proc.ndynam) {
162: default: type = "procedure "; break;
163: case -1: type = "function "; break;
164: case -2: type = "record constructor "; break;
165: }
166: outlen = strlen(type);
167: sneed(len + outlen);
168: STRLOC(arg0) = alcstr(type, outlen);
169: alcstr(s, len);
170: STRLEN(arg0) = len + outlen;
171: return;
172:
173: case T_LIST:
174: /*
175: * Produce:
176: * "list(n)"
177: * where n is the current size of the list.
178: */
179: bp = BLKLOC(arg1);
180: sprintf(sbuf, "list(%d)", bp->list.cursize);
181: len = strlen(sbuf);
182: sneed(len);
183: STRLOC(arg0) = alcstr(sbuf, len);
184: STRLEN(arg0) = len;
185: return;
186:
187: case T_LELEM:
188: STRLEN(arg0) = 18;
189: STRLOC(arg0) = "list element block";
190: return;
191:
192: case T_TABLE:
193: /*
194: * Produce:
195: * "table(n)"
196: * where n is the size of the table.
197: */
198: bp = BLKLOC(arg1);
199: sprintf(sbuf, "table(%d)", bp->table.cursize);
200: len = strlen(sbuf);
201: sneed(len);
202: STRLOC(arg0) = alcstr(sbuf, len);
203: STRLEN(arg0) = len;
204: return;
205:
206: case T_TELEM:
207: STRLEN(arg0) = 19;
208: STRLOC(arg0) = "table element block";
209: return;
210:
211: #ifdef SETS
212: case T_SET:
213: /*
214: * Produce "set(n)" where n is size of the set.
215: */
216: bp = BLKLOC(arg1);
217: sprintf(sbuf, "set(%d)", bp->set.setsize);
218: len = strlen(sbuf);
219: sneed(len);
220: STRLOC(arg0) = alcstr(sbuf,len);
221: STRLEN(arg0) = len;
222: return;
223:
224: case T_SELEM:
225: STRLEN(arg0) = 17;
226: STRLOC(arg0) = "set element block";
227: return;
228: #endif SETS
229:
230: case T_RECORD:
231: /*
232: * Produce:
233: * "record name(n)"
234: * where n is the number of fields.
235: */
236: bp = BLKLOC(arg1);
237: rnlen = STRLEN(bp->record.recptr->recname);
238: sneed(15 + rnlen); /* 15 = *"record " + *"(nnnnnn)" */
239: bp = BLKLOC(arg1);
240: sprintf(sbuf, "(%d)", bp->record.recptr->nfields);
241: len = strlen(sbuf);
242: STRLOC(arg0) = alcstr("record ", 7);
243: alcstr(STRLOC(bp->record.recptr->recname),
244: rnlen);
245: alcstr(sbuf, len);
246: STRLEN(arg0) = 7 + len + rnlen;
247: return;
248:
249: case T_ESTACK:
250: /*
251: * Produce:
252: * "co-expression(n)"
253: * where n is the number of results that have been produced.
254: */
255: sneed(22);
256: sprintf(sbuf, "(%d)", BLKLOC(arg1)->estack.nresults);
257: len = strlen(sbuf);
258: STRLOC(arg0) = alcstr("co-expression", 13);
259: alcstr(sbuf, len);
260: STRLEN(arg0) = 13 + len;
261: return;
262:
263: default:
264: syserr("image: unknown type.");
265: }
266: }
267:
268: Procblock(image,1)
269:
270: /*
271: * doimage(c,q) - allocate character c in string space, with escape
272: * conventions if c is unprintable, '\', or equal to q.
273: * Returns number of characters allocated.
274: */
275:
276: doimage(c, q)
277: int c, q;
278: {
279: static char *cbuf = "\\\0\0\0";
280: extern char *alcstr();
281:
282: if (c >= ' ' && c < '\177') {
283: /*
284: * c is printable, but special case ", ', and \.
285: */
286: switch (c) {
287: case '"':
288: if (c != q) goto def;
289: alcstr("\\\"", 2);
290: return (2);
291: case '\'':
292: if (c != q) goto def;
293: alcstr("\\'", 2);
294: return (2);
295: case '\\':
296: alcstr("\\\\", 2);
297: return (2);
298: default:
299: def:
300: cbuf[0] = c;
301: cbuf[1] = '\0';
302: alcstr(cbuf,1);
303: return (1);
304: }
305: }
306:
307: /*
308: * c is some sort of unprintable character. If it is one of the common
309: * ones, produce a special representation for it, otherwise, produce
310: * its octal value.
311: */
312: switch (c) {
313: case '\b': /* backspace */
314: alcstr("\\b", 2);
315: return (2);
316: case '\177': /* delete */
317: alcstr("\\d", 2);
318: return (2);
319: case '\33': /* escape */
320: alcstr("\\e", 2);
321: return (2);
322: case '\f': /* form feed */
323: alcstr("\\f", 2);
324: return (2);
325: case '\n': /* new line */
326: alcstr("\\n", 2);
327: return (2);
328: case '\r': /* return */
329: alcstr("\\r", 2);
330: return (2);
331: case '\t': /* horizontal tab */
332: alcstr("\\t", 2);
333: return (2);
334: case '\13': /* vertical tab */
335: alcstr("\\v", 2);
336: return (2);
337: default: /* octal constant */
338: cbuf[0] = '\\';
339: cbuf[1] = ((c&0300) >> 6) + '0';
340: cbuf[2] = ((c&070) >> 3) + '0';
341: cbuf[3] = (c&07) + '0';
342: alcstr(cbuf, 4);
343: return (4);
344: }
345: }
346:
347: /*
348: * prescan(d) - return upper bound on length of expanded string. Note
349: * that the only time that prescan is wrong is when the string contains
350: * one of the "special" unprintable characters, e.g. tab.
351: */
352: prescan(d)
353: struct descrip *d;
354: {
355: register int slen, len;
356: register char *s, c;
357:
358: s = STRLOC(*d);
359: len = 0;
360: for (slen = STRLEN(*d); slen > 0; slen--)
361: if ((c = (*s++)) < ' ' || c >= 0177)
362: len += 4;
363: else if (c == '"' || c == '\\' || c == '\'')
364: len += 2;
365: else
366: len++;
367:
368: return (len);
369: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.