Return to aj.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src

Annotation of 43BSD/contrib/apl/src/aj.c, revision 1.1

1.1     ! root        1: static char Sccsid[] = "aj.c @(#)aj.c  1.2     10/1/82 Berkeley ";
        !             2: #include "apl.h"
        !             3: #include <signal.h>
        !             4: 
        !             5: #ifdef vax
        !             6: #define        WSMESG "can't load pdp-11 workspace"
        !             7: #else
        !             8: #define        WSMESG "can't load vax workspace"
        !             9: #endif
        !            10: 
        !            11: 
        !            12: clear()
        !            13: {
        !            14:        register struct nlist *n;
        !            15: 
        !            16:        for(n=nlist; n->namep; n++) {
        !            17:                n->use = 0;
        !            18:                n->itemp = 0;
        !            19:                n->namep = 0;
        !            20:                }
        !            21:                thread.iorg = 1;
        !            22:                srand(thread.rl = 1);
        !            23:                thread.width = 72;
        !            24:                thread.fuzz = 1.0e-13;
        !            25:                afreset();      /* release all dynamic memory */
        !            26:                gsip = 0;       /* reset state indicator */
        !            27: }
        !            28: 
        !            29: lsize(s)
        !            30: char *s;
        !            31: {
        !            32:        register i;
        !            33:        register char *p;
        !            34: 
        !            35:        i=1;
        !            36:        p=s;
        !            37:        while (*p++) i++;
        !            38:        return(i);
        !            39: }
        !            40: 
        !            41: isize(ip)
        !            42: struct item *ip;
        !            43: {
        !            44:        register struct item *p;
        !            45:        register i;
        !            46: 
        !            47:        p=ip;
        !            48:        i = sizeof *p - (MRANK-p->rank)*SINT;
        !            49:        if(p->type == DA)
        !            50:                i += p->size*SDAT; else
        !            51:        if(p->type == CH)
        !            52:                i += p->size;
        !            53:        return(i);
        !            54: }
        !            55: 
        !            56: wsload(ffile)
        !            57: {
        !            58:        struct item *convrt();
        !            59:        char name[NAMS];
        !            60:        union uci iz;
        !            61:        register i;
        !            62:        register struct nlist *n;
        !            63:        register struct item *p;
        !            64:        char c;
        !            65:        int dconv;
        !            66:        struct {
        !            67:                int word;
        !            68:        };
        !            69: 
        !            70:        iz.i = 0;
        !            71: /* Check for correct magic number */
        !            72:        READF(ffile,&iz,sizeof iz);
        !            73:        iz.i &= 0177777;                        /* Zap high bits */
        !            74:        if((iz.i|1) != (MAGIC|1)){
        !            75: barf:
        !            76:                CLOSEF(ffile);
        !            77:                if (((iz.i|1)^2) == (MAGIC|1))
        !            78:                        error(WSMESG);
        !            79:                else
        !            80:                        error("bad ws file format");
        !            81:        }
        !            82:        if(iz.i > MAGIC){
        !            83:                printf("single data converted to double\n");
        !            84:                dconv = 2;
        !            85:        } else if(iz.i < MAGIC){
        !            86:                printf("double data converted to single\n");
        !            87:                dconv = 1;
        !            88:        } else
        !            89:                dconv = 0;
        !            90:        READF(ffile,&thread,sizeof thread);
        !            91:        while(READF(ffile,&iz,sizeof iz) == sizeof iz){
        !            92:                i = iz.cv[1];
        !            93: /* read name of vbl or fn */
        !            94:                READF(ffile,name,i);
        !            95:                for(n=nlist; n->namep; n++)
        !            96:                        if(equal(name, n->namep)){
        !            97:                                erase(n);
        !            98:                                goto hokay;
        !            99:                        }
        !           100:                n->namep = alloc(i);
        !           101:                copy(CH,name,n->namep,i);
        !           102: hokay:
        !           103:                n->use = iz.cv[0];
        !           104:                n->type = LV;
        !           105:                switch(n->use) {
        !           106: default:
        !           107:                        goto barf;
        !           108: 
        !           109: case DA:
        !           110:                        READF(ffile,&iz,sizeof iz);
        !           111:                        p=(struct item *)alloc(iz.i);
        !           112:                        READF(ffile,p,iz.i);
        !           113:                        p->datap = (data *)&p->dim[p->rank]; /*make absolute*/
        !           114:                                /*
        !           115:                                 * convert data type if neccessary
        !           116:                                 */
        !           117:                        n->itemp = convrt(dconv,p);
        !           118:                        continue;
        !           119: case NF:
        !           120: case MF:
        !           121: case DF:
        !           122:                        n->itemp = 0;
        !           123:                        n->label = SEEKF(wfile, 0L, 2);
        !           124:                        do {
        !           125:                                if(READF(ffile,&c,1) != 1)
        !           126:                                        error("wsload eof");
        !           127:                                WRITEF(wfile,&c,1);
        !           128:                        } while(c != 0);
        !           129:                }
        !           130:        }
        !           131:        fdat(ffile);
        !           132:        CLOSEF(ffile);
        !           133: }
        !           134: 
        !           135: wssave(ffile)
        !           136: {
        !           137:        register struct nlist *n;
        !           138: 
        !           139:        nsave(ffile, 0);
        !           140:        for(n=nlist; n->namep; n++)
        !           141:                nsave(ffile, n);
        !           142:        fdat(ffile);
        !           143:        CLOSEF(ffile);
        !           144: }
        !           145: 
        !           146: vsave(fd)
        !           147: {
        !           148:        register struct nlist *n;
        !           149:        struct nlist *getnm();
        !           150: 
        !           151:        nsave(fd, 0);
        !           152:        while(n = getnm())
        !           153:                nsave(fd, n);
        !           154:        fdat(fd);
        !           155:        CLOSEF(fd);
        !           156: }
        !           157: 
        !           158: nsave(ffile, an)
        !           159: struct nlist *an;
        !           160: {
        !           161:        union uci iz;
        !           162:        register struct nlist *n;
        !           163:        register i;
        !           164:        register struct item *p;
        !           165:        char c;
        !           166: 
        !           167:        n = an;
        !           168:        if(n == 0){
        !           169:                iz.i = MAGIC;
        !           170:                WRITEF(ffile,&iz,sizeof iz);
        !           171:                WRITEF(ffile,&thread,sizeof thread);
        !           172:                return(0);
        !           173:        }
        !           174: 
        !           175:        if(n->use == 0 || (n->use == DA && n->itemp == 0))
        !           176:                return(0);
        !           177:        iz.cv[0] = n->use;
        !           178:        iz.cv[1] = i = lsize(n->namep);
        !           179: #ifdef vax
        !           180:        iz.cv[2] = iz.cv[3] = 0;
        !           181: #endif
        !           182:        WRITEF(ffile,&iz,sizeof iz);
        !           183:        WRITEF(ffile,n->namep,i);
        !           184: 
        !           185:        switch(n->use) {
        !           186: default:
        !           187:                CLOSEF(ffile);
        !           188:                error("save B");
        !           189: case DA:
        !           190:                p = n->itemp;
        !           191:                iz.i = i = isize(p);
        !           192:                ((struct nlist *)p)->label -= (int)p;
        !           193:                WRITEF(ffile,&iz,sizeof iz);
        !           194:                WRITEF(ffile,p,i);
        !           195:                ((struct nlist *)p)->label += (int)p;
        !           196:                break;
        !           197: case NF:
        !           198: case MF:
        !           199: case DF:
        !           200:                SEEKF(wfile,(long)n->label,0);
        !           201:                do {
        !           202:                        READF(wfile,&c,1);
        !           203:                        WRITEF(ffile,&c,1);
        !           204:                } while(c != 0);
        !           205:        }
        !           206:        return(0);
        !           207: }
        !           208: 
        !           209: struct nlist *
        !           210: getnm()
        !           211: {
        !           212:        char name[100];
        !           213:        register char *p;
        !           214:        register struct nlist *n;
        !           215:        register c;
        !           216: 
        !           217:        while(1){
        !           218:                printf("variable name? ");
        !           219:                c = READF(1, name, 100);
        !           220:                if(c <= 1)
        !           221:                        return(0);
        !           222:                name[c-1] = 0;
        !           223:                for(n=nlist; n->namep; n++)
        !           224:                        if(equal(name, n->namep))
        !           225:                                return(n);
        !           226:                printf("%s does not exist\n", name);
        !           227:        }
        !           228: }
        !           229: 
        !           230: #ifdef NDIR
        !           231: listdir()
        !           232: {
        !           233:        register pid, i;
        !           234:        register int (*oldint)();
        !           235: 
        !           236:        /* I am not AT ALL happy with the change in the directory
        !           237:         * format.  Until it settles down in an official 4.2BSD
        !           238:         * distribution, just bail out and call "ls".  This solution
        !           239:         * doesn't work properly with ")script" files, but eventually
        !           240:         * I hope to make it internal again.
        !           241:         *                      --John Bruner (06-May-82)
        !           242:         */
        !           243: 
        !           244:        oldint = signal(SIGINT, SIG_IGN);
        !           245:        while ((pid=FORKF(1)) < 0)
        !           246:                sleep(5);
        !           247:        if (!pid) {
        !           248:                signal(SIGINT, SIG_DFL);
        !           249:                execl("/usr/ucb/ls", "ls", 0);  /* for column output */
        !           250:                execl("/bin/ls", "ls", 0);      /* last resort */
        !           251:                write(2, "Can't find \"ls\"!\n", 17);
        !           252:                exit(1);
        !           253:        }
        !           254:        while ((i=wait(0)) > 0 && i != pid);
        !           255:        signal(SIGINT, oldint);
        !           256: }
        !           257: #else
        !           258: listdir()
        !           259: {
        !           260:        register f;
        !           261:        register char *p;
        !           262:        struct direct dir;
        !           263: 
        !           264:        /* List the directory in columnar format. */
        !           265: 
        !           266:        if((f = OPENF(".",0)) < 0)
        !           267:                error("directory B");
        !           268:        while(READF(f,&dir,sizeof dir) == sizeof dir)
        !           269:                if(dir.d_ino != 0 && dir.d_name[0] != '.') {
        !           270:                        if(column+10 >= thread.width)
        !           271:                                printf("\n\t");
        !           272:                        for(p=dir.d_name; p<dir.d_name+14 && *p; p++)
        !           273:                                putchar(*p);
        !           274:                        putchar('\t');
        !           275:                }
        !           276:        putchar('\n');
        !           277:        CLOSEF(f);
        !           278: }
        !           279: #endif
        !           280: 
        !           281: fdat(f)
        !           282: {
        !           283:        struct stat b;
        !           284:        register struct tm *p;
        !           285:        struct tm *localtime();
        !           286: 
        !           287:        FSTATF(f,&b);
        !           288:        p = localtime(&b.st_mtime);
        !           289: 
        !           290:        printf("  ");
        !           291:        pr2d(p->tm_hour);
        !           292:        putchar('.');
        !           293:        pr2d(p->tm_min);
        !           294:        putchar('.');
        !           295:        pr2d(p->tm_sec);
        !           296:        putchar(' ');
        !           297:        pr2d(p->tm_mon+1);
        !           298:        putchar('/');
        !           299:        pr2d(p->tm_mday);
        !           300:        putchar('/');
        !           301:        pr2d(p->tm_year);
        !           302: }
        !           303: 
        !           304: pr2d(i)
        !           305: {
        !           306:        putchar(i/10+'0');
        !           307:        putchar(i % 10 + '0');
        !           308: }
        !           309: 
        !           310: struct item *
        !           311: convrt(m, p)
        !           312: struct item *p;
        !           313: {
        !           314:        register i;
        !           315:        register float *f;
        !           316:        register double *d;
        !           317:        struct item *q;
        !           318: 
        !           319:        if (p->type == CH) return(p);
        !           320:        switch(m){
        !           321:        case 0:
        !           322:                return(p);
        !           323: 
        !           324:        case 1:         /* apl to apl2 */
        !           325:                q = newdat(DA, p->rank, p->size);
        !           326:                f = (float *)q->datap;
        !           327:                d = (double *)p->datap;
        !           328:                for(i=0; i<p->size; i++)
        !           329:                        *f++ = *d++;
        !           330:                break;
        !           331: 
        !           332:        case 2:         /* apl2 to apl */
        !           333:                q = newdat(DA, p->rank, p->size);
        !           334:                f = (float *)p->datap;
        !           335:                d = (double *)q->datap;
        !           336:                for(i=0; i<p->size; i++)
        !           337:                        *d++ = *f++;
        !           338:                break;
        !           339:        }
        !           340:        for(i=0; i<p->rank; i++)
        !           341:                q->dim[i] = p->dim[i];
        !           342:        free(p);
        !           343:        return(q);
        !           344: }

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