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:    }

Defined functions

listimage defined in line 361; used 1 times
outimage defined in line 12; used 9 times
printimage defined in line 294; used 5 times

Defined macros

LISTLIMIT defined in line 5; used 3 times
STRINGLIMIT defined in line 4; used 3 times
Last modified: 1985-01-11
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 1547
Valid CSS Valid XHTML 1.0 Strict