4.3BSD/usr/contrib/icon/rt/outimage.c
#include "../h/rt.h"
#include "../h/record.h"
#define STRINGLIMIT 16 /* limit on length of imaged string */
#define LISTLIMIT 6 /* limit on list items in image */
/*
* outimage - print image of d on file f. If restrict is non-zero,
* fields of records will not be imaged.
*/
outimage(f, d, restrict)
FILE *f;
struct descrip *d;
int restrict;
{
register int i, j;
register char *s;
register union block *bp;
char *type;
FILE *fd;
struct descrip q;
extern char *blkname[];
outimg:
if (NULLDESC(*d)) {
if (restrict == 0)
fprintf(f, "&null");
return;
}
if (QUAL(*d)) {
/*
* *d is a string qualifier. Print STRINGLIMIT characters of it
* using printimage and denote the presence of additional characters
* by terminating the string with "...".
*/
i = STRLEN(*d);
s = STRLOC(*d);
j = MIN(i, STRINGLIMIT);
putc('"', f);
while (j-- > 0)
printimage(f, *s++, '"');
if (i > STRINGLIMIT)
fprintf(f, "...");
putc('"', f);
return;
}
if (VAR(*d) && !TVAR(*d)) {
/*
* *d is a variable. Print "variable =", dereference it and loop
* back to the top to cause the value of the variable to be imaged.
*/
fprintf(f, "variable = ");
d = VARLOC(*d);
goto outimg;
}
switch (TYPE(*d)) {
case T_INTEGER:
fprintf(f, "%d", INTVAL(*d));
return;
#ifdef LONGS
case T_LONGINT:
fprintf(f, "%ld", BLKLOC(*d)->longint.intval);
return;
#endif LONGS
case T_REAL:
{
char s[30];
struct descrip junk;
rtos(BLKLOC(*d)->realblk.realval, &junk, s);
fprintf(f, "%s", s);
return;
}
case T_CSET:
/*
* Check for distinguished csets by looking at the address of
* of the object to image. If one is found, print its name.
*/
if (BLKLOC(*d) == (union block *) &k_ascii) {
fprintf(f, "&ascii");
return;
}
else if (BLKLOC(*d) == (union block *) &k_cset) {
fprintf(f, "&cset");
return;
}
else if (BLKLOC(*d) == (union block *) &k_lcase) {
fprintf(f, "&lcase");
return;
}
else if (BLKLOC(*d) == (union block *) &k_ucase) {
fprintf(f, "&ucase");
return;
}
/*
* Use printimage to print each character in the cset. Follow
* with "..." if the cset contains more than STRINGLIMIT
* characters.
*/
putc('\'', f);
j = STRINGLIMIT;
for (i = 0; i < 256; i++) {
if (tstb(i, BLKLOC(*d)->cset.bits)) {
if (j-- <= 0) {
fprintf(f, "...");
break;
}
printimage(f, i, '\'');
}
}
putc('\'', f);
return;
case T_FILE:
/*
* Check for distinguished files by looking at the address of
* of the object to image. If one is found, print its name.
*/
if ((fd = BLKLOC(*d)->file.fd) == stdin)
fprintf(f, "&input");
else if (fd == stdout)
fprintf(f, "&output");
else if (fd == stderr)
fprintf(f, "&output");
else {
/*
* The file isn't a special one, just print "file(name)".
*/
i = STRLEN(BLKLOC(*d)->file.fname);
s = STRLOC(BLKLOC(*d)->file.fname);
fprintf(f, "file(");
while (i-- > 0)
printimage(f, *s++, '\0');
putc(')', f);
}
return;
case T_PROC:
/*
* Produce one of:
* "procedure name"
* "function name"
* "record constructor name"
*
* Note that the number of dynamic locals is used to determine
* what type of "procedure" is at hand.
*/
i = STRLEN(BLKLOC(*d)->proc.pname);
s = STRLOC(BLKLOC(*d)->proc.pname);
switch (BLKLOC(*d)->proc.ndynam) {
default: type = "procedure"; break;
case -1: type = "function"; break;
case -2: type = "record constructor"; break;
}
fprintf(f, "%s ", type);
while (i-- > 0)
printimage(f, *s++, '\0');
return;
case T_LIST:
/*
* listimage does the work for lists.
*/
listimage(f, BLKLOC(*d), restrict);
return;
case T_TABLE:
/*
* Print "table(n)" where n is the size of the table.
*/
fprintf(f, "table(%d)", BLKLOC(*d)->table.cursize);
return;
#ifdef SETS
case T_SET:
/*
* print "set(n)" where n is the cardinality of the set
*/
fprintf(f,"set(%d)",BLKLOC(*d)->set.setsize);
return;
#endif SETS
case T_RECORD:
/*
* If restrict is non-zero, print "record(n)" where n is the
* number of fields in the record. If restrict is zero, print
* the image of each field instead of the number of fields.
*/
bp = BLKLOC(*d);
i = STRLEN(bp->record.recptr->recname);
s = STRLOC(bp->record.recptr->recname);
fprintf(f, "record ");
while (i-- > 0)
printimage(f, *s++, '\0');
j = bp->record.recptr->nfields;
if (j <= 0)
fprintf(f, "()");
else if (restrict > 0)
fprintf(f, "(%d)", j);
else {
putc('(', f);
i = 0;
for (;;) {
outimage(f, &bp->record.fields[i], restrict+1);
if (++i >= j)
break;
putc(',', f);
}
putc(')', f);
}
return;
case T_TVSUBS:
/*
* Produce "v[i+:j] = value" where v is the image of the variable
* containing the substring, i is starting position of the substring
* j is the length, and value is the string v[i+:j]. If the length
* (j) is one, just produce "v[i] = value".
*/
bp = BLKLOC(*d);
outimage(f, VARLOC(bp->tvsubs.ssvar), restrict);
if (bp->tvsubs.sslen == 1)
fprintf(f, "[%d]", bp->tvsubs.sspos);
else
fprintf(f, "[%d+:%d]", bp->tvsubs.sspos, bp->tvsubs.sslen);
if (QUAL(*VARLOC(bp->tvsubs.ssvar))) {
STRLEN(q) = bp->tvsubs.sslen;
STRLOC(q) = STRLOC(*VARLOC(bp->tvsubs.ssvar)) + bp->tvsubs.sspos-1;
fprintf(f, " = ");
d = &q;
goto outimg;
}
return;
case T_TVTBL:
bp = BLKLOC(*d);
/*
* It is possible that descriptor d which thinks it is pointing
* at a TVTBL may actually be pointing at a TELEM which had
* been converted from a trapped variable. Check for this first
* and if it is a TELEM produce the outimage of its value.
*/
if (bp->tvtbl.type == T_TELEM) {
outimage(f,&bp->tvtbl.tvtval,restrict);
return;
}
/*
* It really was a TVTBL - Produce "t[s]" where t is the image of
* the table containing the element and s is the image of the
* subscript.
*/
else {
outimage(f, &bp->tvtbl.tvtable, restrict);
putc('[', f);
outimage(f, &bp->tvtbl.tvtref, restrict);
putc(']', f);
return;
}
case T_TVPOS:
fprintf(f, "&pos = %d", k_pos);
return;
case T_TVRAND:
fprintf(f, "&random = %ld", k_random);
return;
case T_TVTRACE:
fprintf(f, "&trace = %d", k_trace);
return;
case T_ESTACK:
fprintf(f, "co-expression");
return;
default:
if (TYPE(*d) <= MAXTYPE)
fprintf(f, "%s", blkname[TYPE(*d)]);
else
syserr("outimage: unknown type");
}
}
/*
* printimage - print character c on file f using escape conventions
* if c is unprintable, '\', or equal to q.
*/
static printimage(f, c, q)
FILE *f;
int c, q;
{
if (c >= ' ' && c < '\177') {
/*
* c is printable, but special case ", ', and \.
*/
switch (c) {
case '"':
if (c != q) goto def;
fprintf(f, "\\\"");
return;
case '\'':
if (c != q) goto def;
fprintf(f, "\\'");
return;
case '\\':
fprintf(f, "\\\\");
return;
default:
def:
putc(c, f);
return;
}
}
/*
* c is some sort of unprintable character. If it one of the common
* ones, produce a special representation for it, otherwise, produce
* its octal value.
*/
switch (c) {
case '\b': /* backspace */
fprintf(f, "\\b");
return;
case '\177': /* delete */
fprintf(f, "\\d");
return;
case '\33': /* escape */
fprintf(f, "\\e");
return;
case '\f': /* form feed */
fprintf(f, "\\f");
return;
case '\n': /* new line */
fprintf(f, "\\n");
return;
case '\r': /* return */
fprintf(f, "\\r");
return;
case '\t': /* horizontal tab */
fprintf(f, "\\t");
return;
case '\13': /* vertical tab */
fprintf(f, "\\v");
return;
default: /* octal constant */
fprintf(f, "\\%03o", c&0377);
return;
}
}
/*
* listimage - print an image of a list.
*/
static listimage(f, lp, restrict)
FILE *f;
struct b_list *lp;
int restrict;
{
register int i, j;
register struct b_lelem *bp;
int size, count;
bp = (struct b_lelem *) BLKLOC(lp->listhead);
size = lp->cursize;
if (restrict > 0 && size > 0) {
/*
* Just give indication of size if the list isn't empty.
*/
fprintf(f, "list(%d)", size);
return;
}
/*
* Print [e1,...,en] on f. If more than LISTLIMIT elements are in the
* list, produce the first LISTLIMIT/2 elements, an ellipsis, and the
* last LISTLIMIT elements.
*/
putc('[', f);
count = 1;
i = 0;
if (size > 0) {
for (;;) {
if (++i > bp->nused) {
i = 1;
bp = (struct b_lelem *) BLKLOC(bp->listnext);
}
if (count <= LISTLIMIT/2 || count > size - LISTLIMIT/2) {
j = bp->first + i - 1;
if (j >= bp->nelem)
j -= bp->nelem;
outimage(f, &bp->lslots[j], restrict+1);
if (count >= size)
break;
putc(',', f);
}
else if (count == LISTLIMIT/2 + 1)
fprintf(f, "...,");
count++;
}
}
putc(']', f);
}