2.11BSD#431 - /usr/src/new/OLD/apl/src/aj.c

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

Defined functions

Defined variables

Defined macros