Return to image.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / functions

Annotation of 43BSD/contrib/icon/functions/image.c, revision 1.1

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.