Return to nio.c CVS log

Up to [Research Unix] / researchv10dc / libI77 / notused

Annotation of researchv10dc/libI77/notused/nio.c, revision 1.1

1.1     ! root        1: /*     @(#)nio.c       1.1     */
        !             2: #include <stdio.h>
        !             3: #include <ctype.h>
        !             4: #include "fio.h"
        !             5: #include "fmt.h"
        !             6: #include "lio.h"
        !             7: 
        !             8: /*
        !             9:  *     namelist io
        !            10:  *
        !            11:  *     see f77's proc.c at namelist() for description
        !            12:  */
        !            13: 
        !            14: typedef struct {
        !            15:        int     ndims;                  /* # of dimensions */
        !            16:        int     nels;                   /* # of elements */
        !            17:        int     baseoff;                /* how to get to (0,...,0) element */
        !            18:        int     span[7];                /* span of each dimension +1+ */
        !            19: } Dims;                                        /* dimension descriptor */
        !            20: 
        !            21: 
        !            22:                                        /* +1+ note: only # of dimensions
        !            23:                                        applies here, i.e. actual array
        !            24:                                        is between 0 and 7 elements based
        !            25:                                        on ndims */
        !            26: 
        !            27: typedef union {
        !            28:        char    *pchar;
        !            29:        short   *pshort;
        !            30:        int     *pint;
        !            31:        long    *plong;
        !            32:        float   *pfloat;
        !            33:        double  *pdouble;
        !            34:        char    **pptr;
        !            35: } Pointer;                             /* pointer to all sorts of things */
        !            36: 
        !            37: 
        !            38: typedef struct {
        !            39:        char    varname[18];            /* name of variable */
        !            40:        Pointer varaddr;                /* where it is */
        !            41:        int     type;                   /* its type */
        !            42:        Dims    *dimp;                  /* dimension descriptor */
        !            43: } Nlentry;                             /* namelist entry: 1 for each var */
        !            44: 
        !            45: 
        !            46: typedef struct {
        !            47:        char    nlname[18];             /* name of namelist */
        !            48:        Nlentry nlvnames[1];            /* array of variable descriptors +2+*/
        !            49: } Namelist;
        !            50: 
        !            51:                                        /* +2+ note: this array is not bounded
        !            52:                                        but is terminated by an entry with a
        !            53:                                        null varname */
        !            54: 
        !            55: /*
        !            56:  * s_rsne - start read namelist external
        !            57:  *
        !            58:  * s_rsne
        !            59:  *     if (file not initialized)
        !            60:  *             intialize it
        !            61:  *     if (file doesn't jive with namelist io)
        !            62:  *             return error
        !            63:  *     initialize some global variables
        !            64:  *     if (not currently reading on file OR not capable of doing so)
        !            65:  *             return error
        !            66:  *     read namelist name
        !            67:  *     if (not correct namelist name)
        !            68:  *             error
        !            69:  *     determine number of variables in namelist
        !            70:  *     read variable name
        !            71:  *     while (variable name is not "&end")
        !            72:  *             if (variable is in namelist)
        !            73:  *                     read value(s) for it
        !            74:  *             else
        !            75:  *                     error
        !            76:  *     if (not correct number of variables read)
        !            77:  *             error
        !            78:  * end s_rsne
        !            79:  */
        !            80: 
        !            81: #define BSIZ 50
        !            82: 
        !            83: static char nlrs[] = "namelist read";
        !            84: 
        !            85: s_rsne(pnlarg)
        !            86: cilist *pnlarg;
        !            87: {
        !            88:        Namelist *pnl;
        !            89:        Nlentry *pnlent, *findit();
        !            90:        int nvars, n;
        !            91:        char buf[BSIZ], *getword();
        !            92: 
        !            93:        if (!init)
        !            94:                f_init();
        !            95:        if (n = c_nle(pnlarg))
        !            96:                return (n);
        !            97:        reading = external = sequential = 1;
        !            98:        formatted = 0;
        !            99:        if (curunit->uwrt && nowreading(curunit))
        !           100:                return (1);
        !           101:        pnl = (Namelist *) pnlarg->cifmt;
        !           102:        if (getc(cf) != ' ' || getc(cf) != '&')
        !           103:                err(pnlarg->cierr, 115, nlrs);
        !           104:        if (strcmp(pnl->nlname, getword(buf, strlen(pnl->nlname))))
        !           105:                err(pnlarg->cierr, 118, buf);
        !           106:        n = getc(cf);
        !           107:        if (!isspace(n))
        !           108:                err(pnlarg->cierr, 115, nlrs);
        !           109:        for (nvars=0, pnlent = pnl->nlvnames; strlen(pnlent->varname); ++pnlent)
        !           110:                ++nvars;
        !           111:        n = 0;
        !           112:        elist = pnlarg;
        !           113:        while (nvars--)
        !           114:                {
        !           115:                if (!getword(buf, BSIZ - 1))
        !           116:                        err(pnlarg->cierr, 120, nlrs);
        !           117:                if (!strcmp(buf, "&end"))
        !           118:                        err(pnlarg->cierr, 121, nlrs);
        !           119:                if (!(pnlent = findit(buf, pnl->nlvnames)))
        !           120:                        err(pnlarg->cierr, 119, buf);
        !           121:                if (getvar(pnlent))
        !           122:                        err(pnlarg->cierr, 120, nlrs);
        !           123:                }
        !           124:        if (!getword(buf, BSIZ - 1))
        !           125:                err(pnlarg->cierr, 120, nlrs);
        !           126:        if (strcmp(buf, "&end"))
        !           127:                err(pnlarg->cierr, 121, nlrs);
        !           128:        return (0);
        !           129: }
        !           130: 
        !           131: /* miscellaneous utility functions for namelist read */
        !           132: 
        !           133: /* getword - get a "word" text string from current file */
        !           134: 
        !           135: char *getword(s, n)
        !           136: char *s;
        !           137: int n;
        !           138: {
        !           139:        int i;
        !           140:        char *p;
        !           141: 
        !           142:        p = s;
        !           143:        i = getc(cf);
        !           144:        while (isspace(i) || (ispunct(i) && i != '&'))
        !           145:                i = getc(cf);
        !           146:        while (n--)
        !           147:                {
        !           148:                if (i != EOF && i != '=' && !isspace(i))
        !           149:                        if (isupper(i))
        !           150:                                *p++ = tolower(i);
        !           151:                        else
        !           152:                                *p++ = i;
        !           153:                else
        !           154:                        break;
        !           155:                i = getc(cf);
        !           156:                }
        !           157:        if (feof(cf) && p == s)
        !           158:                return (NULL);
        !           159:        *p = '\0';
        !           160:        return (s);
        !           161: }
        !           162: 
        !           163: /* findit - find key in list of Nlentrys */
        !           164: 
        !           165: Nlentry *findit(key, list)
        !           166: char *key;
        !           167: Nlentry *list;
        !           168: {
        !           169:        while (strlen(list->varname))
        !           170:                {
        !           171:                if (!strcmp(key, list->varname))
        !           172:                        return (list);
        !           173:                else
        !           174:                        ++list;
        !           175:                }
        !           176:        return (NULL);
        !           177: }
        !           178: 
        !           179: /* getvar - read values for namelist io
        !           180:  *
        !           181:  * getvar uses l_read of list io to do all the dirty work, therefore
        !           182:  * it should be inserted into the library before lread.c (on UNIX
        !           183:  * systems with barbaric topologically sorted libraries)
        !           184:  *
        !           185:  * It sets the cierr flag so that l_read (and its subordinates) will
        !           186:  * not report errors, but pass them back so that the diagnostic message
        !           187:  * will appear to come from "namelist read".
        !           188:  */
        !           189: 
        !           190: getvar(pnlent)
        !           191: Nlentry *pnlent;
        !           192: {
        !           193:        int n, i, size;
        !           194: 
        !           195:        if (pnlent->dimp)
        !           196:                n = pnlent->dimp->nels;
        !           197:        else
        !           198:                n = 1;
        !           199:        elist->cierr = 1;
        !           200:        switch (pnlent->type)
        !           201:                {
        !           202:                case TYADDR:
        !           203:                        size = sizeof(char *);
        !           204:                        break;
        !           205:                case TYSHORT:
        !           206:                        size = sizeof(short);
        !           207:                        break;
        !           208:                case TYLOGICAL:
        !           209:                case TYLONG:
        !           210:                        size = sizeof(long);
        !           211:                        break;
        !           212:                case TYREAL:
        !           213:                case TYCOMPLEX:
        !           214:                        size = sizeof(float);
        !           215:                        break;
        !           216:                case TYDREAL:
        !           217:                case TYDCOMPLEX:
        !           218:                        size = sizeof(double);
        !           219:                        break;
        !           220:                default:
        !           221:                        if (pnlent->type < 0)
        !           222:                                {
        !           223:                                if (n = l_read(&n, pnlent->varaddr,
        !           224:                                            -pnlent->type, TYCHAR))
        !           225:                                        err(elist->cierr = 0, n, nlrs);
        !           226:                                return (0);
        !           227:                                }
        !           228:                        else
        !           229:                                err(elist->cierr = 0, 117, nlrs);
        !           230:                }
        !           231:        if (n = l_read(&n, pnlent->varaddr, size, pnlent->type))
        !           232:                err(0, n, nlrs);
        !           233:        elist->cierr = 0;
        !           234:        return (0);
        !           235: }
        !           236: 
        !           237: /*
        !           238:  * s_wsne - start write namelist external
        !           239:  *
        !           240:  * s_wsne
        !           241:  *     if (file not initialized)
        !           242:  *             initialize it
        !           243:  *     if (file doesn't jive with namelist io)
        !           244:  *             return error
        !           245:  *     initialize some global variables
        !           246:  *     if (not currently writing on file OR not capable of doing so)
        !           247:  *             return error
        !           248:  *     set up namelist and entry pointers
        !           249:  *     output namelist name in proper format
        !           250:  *     do
        !           251:  *             output variable name
        !           252:  *             output value based on type
        !           253:  *             point to next entry
        !           254:  *     while (there are more to do AND sneakily output a comma separator
        !           255:  *     output end line
        !           256:  * end s_wsne
        !           257:  */
        !           258: 
        !           259: s_wsne(pnlarg)
        !           260: cilist *pnlarg;
        !           261: {
        !           262:        Namelist *pnl;
        !           263:        Nlentry *pnlent;
        !           264:        Pointer ptr;
        !           265:        int i, n, vtype;
        !           266:        char *pch, buf[BSIZ];
        !           267: 
        !           268:        if (!init)
        !           269:                f_init();
        !           270:        if (n = c_nle(pnlarg))
        !           271:                return(n);
        !           272:        reading = formatted = 0;
        !           273:        external = sequential = 1;
        !           274:        if (!curunit->uwrt && nowwriting(curunit))
        !           275:                return(1);
        !           276:        pnl = (Namelist *) pnlarg->cifmt;
        !           277:        (void) putc(' ', cf);
        !           278:        (void) putc('&', cf);
        !           279:        (void) fputs(pnl->nlname, cf);
        !           280:        (void) putc('\n', cf);
        !           281:        (void) putc(' ', cf);
        !           282:        pnlent = pnl->nlvnames;
        !           283:        do {
        !           284:                (void) fputs(pnlent->varname, cf);
        !           285:                (void) putc('=', cf);
        !           286:                if (pnlent->dimp)
        !           287:                        n = pnlent->dimp->nels;
        !           288:                else
        !           289:                        n = 1;
        !           290:                if ((vtype = pnlent->type) < 0 && (pch = pnlent->varaddr.pchar))
        !           291:                        do {
        !           292:                                (void) putc('\'', cf);
        !           293:                                for (i = vtype; i; ++i)
        !           294:                                        (void) putc(*pch++, cf);
        !           295:                                (void) putc('\'', cf);
        !           296:                        } while (--n && !t_putc(','));
        !           297:                else
        !           298:                        {
        !           299:                        ptr.pchar = pnlent->varaddr.pchar;
        !           300:                        do { switch (vtype)
        !           301:                                {
        !           302:                                case TYADDR:
        !           303:                                        (void) sprintf(buf,"0x%x", *ptr.pptr++);
        !           304:                                        break;
        !           305:                                case TYSHORT:
        !           306:                                        (void) sprintf(buf,"%d", *ptr.pshort++);
        !           307:                                        break;
        !           308:                                case TYLONG:
        !           309:                                        (void) sprintf(buf,"%ld", *ptr.plong++);
        !           310:                                        break;
        !           311:                                case TYREAL:
        !           312:                                        (void)sprintf(buf,"%.8f",*ptr.pfloat++);
        !           313:                                        break;
        !           314:                                case TYDREAL:
        !           315:                                        (void) sprintf(buf, "%.18e",
        !           316:                                            *ptr.pdouble++);
        !           317:                                        break;
        !           318:                                case TYCOMPLEX:
        !           319:                                        (void) sprintf(buf, "(%.8f,%.8f)",
        !           320:                                            *ptr.pfloat, *(ptr.pfloat+1));
        !           321:                                        ptr.pfloat += 2;
        !           322:                                        break;
        !           323:                                case TYDCOMPLEX:
        !           324:                                        (void) sprintf(buf, "(%.18e,%.18e)",
        !           325:                                            *ptr.pdouble, *(ptr.pdouble+1));
        !           326:                                        ptr.pdouble += 2;
        !           327:                                        break;
        !           328:                                case TYCHAR:
        !           329:                                        (void) sprintf(buf, "%c", *ptr.pchar++);
        !           330:                                        break;
        !           331:                                case TYLOGICAL:
        !           332:                                        (void) sprintf(buf, ".%s.",
        !           333:                                            (*ptr.plong ? "TRUE" : "FALSE"));
        !           334:                                        break;
        !           335:                                default:
        !           336:                                        err(pnlarg->cierr, 117, "namelist io");
        !           337:                                }
        !           338:                                (void) fputs(buf, cf);
        !           339:                        } while (--n && !t_putc(','));
        !           340:                        }
        !           341:                ++pnlent;
        !           342:        } while (strlen(pnlent->varname) && !t_putc(','));
        !           343:        (void) fputs("\n &end\n", cf);
        !           344:        return (0);
        !           345: }
        !           346: 
        !           347: /*
        !           348:  * c_nle - check namelist external
        !           349:  *
        !           350:  * c_nle
        !           351:  *     set up global variables
        !           352:  *     if (bogus unit)
        !           353:  *             fatal error
        !           354:  *     if (unit is unitialized AND can't be)
        !           355:  *             fatal error
        !           356:  *     if (can't do unformatted io on unit)
        !           357:  *             fatal error
        !           358:  * end c_nle
        !           359:  */
        !           360: 
        !           361: 
        !           362: c_nle(pcl)
        !           363: cilist *pcl;
        !           364: {
        !           365:        fmtbuf = "namelist io";
        !           366:        if (0 > pcl->ciunit || pcl->ciunit >= MXUNIT)
        !           367:                err(pcl->cierr, 101, "start namelist io");
        !           368:        scale = recpos = 0;
        !           369:        curunit = &units[pcl->ciunit];
        !           370:        if (curunit->ufd == NULL && fk_open(SEQ, FMT, pcl->ciunit))
        !           371:                err(pcl->cierr, 102, "namelist io");
        !           372:        cf = curunit->ufd;
        !           373:        if (!curunit->ufmt)
        !           374:                err(pcl->cierr, 103, "namelist io");
        !           375:        return(0);
        !           376: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.