|
|
1.1 root 1: #include "../h/rt.h"
2: #include "../h/record.h"
3:
4: #define STRINGLIMIT 16 /* limit on length of imaged string */
5: #define LISTLIMIT 6 /* limit on list items in image */
6:
7: /*
8: * outimage - print image of d on file f. If restrict is non-zero,
9: * fields of records will not be imaged.
10: */
11:
12: outimage(f, d, restrict)
13: FILE *f;
14: struct descrip *d;
15: int restrict;
16: {
17: register int i, j;
18: register char *s;
19: register union block *bp;
20: char *type;
21: FILE *fd;
22: struct descrip q;
23: extern char *blkname[];
24:
25: outimg:
26: if (NULLDESC(*d)) {
27: if (restrict == 0)
28: fprintf(f, "&null");
29: return;
30: }
31:
32: if (QUAL(*d)) {
33: /*
34: * *d is a string qualifier. Print STRINGLIMIT characters of it
35: * using printimage and denote the presence of additional characters
36: * by terminating the string with "...".
37: */
38: i = STRLEN(*d);
39: s = STRLOC(*d);
40: j = MIN(i, STRINGLIMIT);
41: putc('"', f);
42: while (j-- > 0)
43: printimage(f, *s++, '"');
44: if (i > STRINGLIMIT)
45: fprintf(f, "...");
46: putc('"', f);
47: return;
48: }
49:
50: if (VAR(*d) && !TVAR(*d)) {
51: /*
52: * *d is a variable. Print "variable =", dereference it and loop
53: * back to the top to cause the value of the variable to be imaged.
54: */
55: fprintf(f, "variable = ");
56: d = VARLOC(*d);
57: goto outimg;
58: }
59:
60: switch (TYPE(*d)) {
61:
62: case T_INTEGER:
63: fprintf(f, "%d", INTVAL(*d));
64: return;
65:
66: #ifdef LONGS
67: case T_LONGINT:
68: fprintf(f, "%ld", BLKLOC(*d)->longint.intval);
69: return;
70: #endif LONGS
71: case T_REAL:
72: {
73: char s[30];
74: struct descrip junk;
75: rtos(BLKLOC(*d)->realblk.realval, &junk, s);
76: fprintf(f, "%s", s);
77: return;
78: }
79:
80: case T_CSET:
81: /*
82: * Check for distinguished csets by looking at the address of
83: * of the object to image. If one is found, print its name.
84: */
85: if (BLKLOC(*d) == (union block *) &k_ascii) {
86: fprintf(f, "&ascii");
87: return;
88: }
89: else if (BLKLOC(*d) == (union block *) &k_cset) {
90: fprintf(f, "&cset");
91: return;
92: }
93: else if (BLKLOC(*d) == (union block *) &k_lcase) {
94: fprintf(f, "&lcase");
95: return;
96: }
97: else if (BLKLOC(*d) == (union block *) &k_ucase) {
98: fprintf(f, "&ucase");
99: return;
100: }
101: /*
102: * Use printimage to print each character in the cset. Follow
103: * with "..." if the cset contains more than STRINGLIMIT
104: * characters.
105: */
106: putc('\'', f);
107: j = STRINGLIMIT;
108: for (i = 0; i < 256; i++) {
109: if (tstb(i, BLKLOC(*d)->cset.bits)) {
110: if (j-- <= 0) {
111: fprintf(f, "...");
112: break;
113: }
114: printimage(f, i, '\'');
115: }
116: }
117: putc('\'', f);
118: return;
119:
120: case T_FILE:
121: /*
122: * Check for distinguished files by looking at the address of
123: * of the object to image. If one is found, print its name.
124: */
125: if ((fd = BLKLOC(*d)->file.fd) == stdin)
126: fprintf(f, "&input");
127: else if (fd == stdout)
128: fprintf(f, "&output");
129: else if (fd == stderr)
130: fprintf(f, "&output");
131: else {
132: /*
133: * The file isn't a special one, just print "file(name)".
134: */
135: i = STRLEN(BLKLOC(*d)->file.fname);
136: s = STRLOC(BLKLOC(*d)->file.fname);
137: fprintf(f, "file(");
138: while (i-- > 0)
139: printimage(f, *s++, '\0');
140: putc(')', f);
141: }
142: return;
143:
144: case T_PROC:
145: /*
146: * Produce one of:
147: * "procedure name"
148: * "function name"
149: * "record constructor name"
150: *
151: * Note that the number of dynamic locals is used to determine
152: * what type of "procedure" is at hand.
153: */
154: i = STRLEN(BLKLOC(*d)->proc.pname);
155: s = STRLOC(BLKLOC(*d)->proc.pname);
156: switch (BLKLOC(*d)->proc.ndynam) {
157: default: type = "procedure"; break;
158: case -1: type = "function"; break;
159: case -2: type = "record constructor"; break;
160: }
161: fprintf(f, "%s ", type);
162: while (i-- > 0)
163: printimage(f, *s++, '\0');
164: return;
165:
166: case T_LIST:
167: /*
168: * listimage does the work for lists.
169: */
170: listimage(f, BLKLOC(*d), restrict);
171: return;
172:
173: case T_TABLE:
174: /*
175: * Print "table(n)" where n is the size of the table.
176: */
177: fprintf(f, "table(%d)", BLKLOC(*d)->table.cursize);
178: return;
179: #ifdef SETS
180: case T_SET:
181: /*
182: * print "set(n)" where n is the cardinality of the set
183: */
184: fprintf(f,"set(%d)",BLKLOC(*d)->set.setsize);
185: return;
186: #endif SETS
187:
188: case T_RECORD:
189: /*
190: * If restrict is non-zero, print "record(n)" where n is the
191: * number of fields in the record. If restrict is zero, print
192: * the image of each field instead of the number of fields.
193: */
194: bp = BLKLOC(*d);
195: i = STRLEN(bp->record.recptr->recname);
196: s = STRLOC(bp->record.recptr->recname);
197: fprintf(f, "record ");
198: while (i-- > 0)
199: printimage(f, *s++, '\0');
200: j = bp->record.recptr->nfields;
201: if (j <= 0)
202: fprintf(f, "()");
203: else if (restrict > 0)
204: fprintf(f, "(%d)", j);
205: else {
206: putc('(', f);
207: i = 0;
208: for (;;) {
209: outimage(f, &bp->record.fields[i], restrict+1);
210: if (++i >= j)
211: break;
212: putc(',', f);
213: }
214: putc(')', f);
215: }
216: return;
217:
218: case T_TVSUBS:
219: /*
220: * Produce "v[i+:j] = value" where v is the image of the variable
221: * containing the substring, i is starting position of the substring
222: * j is the length, and value is the string v[i+:j]. If the length
223: * (j) is one, just produce "v[i] = value".
224: */
225: bp = BLKLOC(*d);
226: outimage(f, VARLOC(bp->tvsubs.ssvar), restrict);
227: if (bp->tvsubs.sslen == 1)
228: fprintf(f, "[%d]", bp->tvsubs.sspos);
229: else
230: fprintf(f, "[%d+:%d]", bp->tvsubs.sspos, bp->tvsubs.sslen);
231: if (QUAL(*VARLOC(bp->tvsubs.ssvar))) {
232: STRLEN(q) = bp->tvsubs.sslen;
233: STRLOC(q) = STRLOC(*VARLOC(bp->tvsubs.ssvar)) + bp->tvsubs.sspos-1;
234: fprintf(f, " = ");
235: d = &q;
236: goto outimg;
237: }
238: return;
239:
240: case T_TVTBL:
241: bp = BLKLOC(*d);
242: /*
243: * It is possible that descriptor d which thinks it is pointing
244: * at a TVTBL may actually be pointing at a TELEM which had
245: * been converted from a trapped variable. Check for this first
246: * and if it is a TELEM produce the outimage of its value.
247: */
248: if (bp->tvtbl.type == T_TELEM) {
249: outimage(f,&bp->tvtbl.tvtval,restrict);
250: return;
251: }
252: /*
253: * It really was a TVTBL - Produce "t[s]" where t is the image of
254: * the table containing the element and s is the image of the
255: * subscript.
256: */
257: else {
258: outimage(f, &bp->tvtbl.tvtable, restrict);
259: putc('[', f);
260: outimage(f, &bp->tvtbl.tvtref, restrict);
261: putc(']', f);
262: return;
263: }
264:
265: case T_TVPOS:
266: fprintf(f, "&pos = %d", k_pos);
267: return;
268:
269: case T_TVRAND:
270: fprintf(f, "&random = %ld", k_random);
271: return;
272:
273: case T_TVTRACE:
274: fprintf(f, "&trace = %d", k_trace);
275: return;
276:
277: case T_ESTACK:
278: fprintf(f, "co-expression");
279: return;
280:
281: default:
282: if (TYPE(*d) <= MAXTYPE)
283: fprintf(f, "%s", blkname[TYPE(*d)]);
284: else
285: syserr("outimage: unknown type");
286: }
287: }
288:
289: /*
290: * printimage - print character c on file f using escape conventions
291: * if c is unprintable, '\', or equal to q.
292: */
293:
294: static printimage(f, c, q)
295: FILE *f;
296: int c, q;
297: {
298: if (c >= ' ' && c < '\177') {
299: /*
300: * c is printable, but special case ", ', and \.
301: */
302: switch (c) {
303: case '"':
304: if (c != q) goto def;
305: fprintf(f, "\\\"");
306: return;
307: case '\'':
308: if (c != q) goto def;
309: fprintf(f, "\\'");
310: return;
311: case '\\':
312: fprintf(f, "\\\\");
313: return;
314: default:
315: def:
316: putc(c, f);
317: return;
318: }
319: }
320:
321: /*
322: * c is some sort of unprintable character. If it one of the common
323: * ones, produce a special representation for it, otherwise, produce
324: * its octal value.
325: */
326: switch (c) {
327: case '\b': /* backspace */
328: fprintf(f, "\\b");
329: return;
330: case '\177': /* delete */
331: fprintf(f, "\\d");
332: return;
333: case '\33': /* escape */
334: fprintf(f, "\\e");
335: return;
336: case '\f': /* form feed */
337: fprintf(f, "\\f");
338: return;
339: case '\n': /* new line */
340: fprintf(f, "\\n");
341: return;
342: case '\r': /* return */
343: fprintf(f, "\\r");
344: return;
345: case '\t': /* horizontal tab */
346: fprintf(f, "\\t");
347: return;
348: case '\13': /* vertical tab */
349: fprintf(f, "\\v");
350: return;
351: default: /* octal constant */
352: fprintf(f, "\\%03o", c&0377);
353: return;
354: }
355: }
356:
357: /*
358: * listimage - print an image of a list.
359: */
360:
361: static listimage(f, lp, restrict)
362: FILE *f;
363: struct b_list *lp;
364: int restrict;
365: {
366: register int i, j;
367: register struct b_lelem *bp;
368: int size, count;
369:
370: bp = (struct b_lelem *) BLKLOC(lp->listhead);
371: size = lp->cursize;
372:
373: if (restrict > 0 && size > 0) {
374: /*
375: * Just give indication of size if the list isn't empty.
376: */
377: fprintf(f, "list(%d)", size);
378: return;
379: }
380:
381: /*
382: * Print [e1,...,en] on f. If more than LISTLIMIT elements are in the
383: * list, produce the first LISTLIMIT/2 elements, an ellipsis, and the
384: * last LISTLIMIT elements.
385: */
386: putc('[', f);
387: count = 1;
388: i = 0;
389: if (size > 0) {
390: for (;;) {
391: if (++i > bp->nused) {
392: i = 1;
393: bp = (struct b_lelem *) BLKLOC(bp->listnext);
394: }
395: if (count <= LISTLIMIT/2 || count > size - LISTLIMIT/2) {
396: j = bp->first + i - 1;
397: if (j >= bp->nelem)
398: j -= bp->nelem;
399: outimage(f, &bp->lslots[j], restrict+1);
400: if (count >= size)
401: break;
402: putc(',', f);
403: }
404: else if (count == LISTLIMIT/2 + 1)
405: fprintf(f, "...,");
406: count++;
407: }
408: }
409: putc(']', f);
410: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.