|
|
1.1 ! root 1: static char Sccsid[] = "az.c @(#)az.c 1.1 10/1/82 Berkeley "; ! 2: #include "apl.h" ! 3: #include <signal.h> ! 4: ! 5: char *iofname(); ! 6: ! 7: ! 8: /* ! 9: * misc. other routines ! 10: */ ! 11: ! 12: ex_exit() ! 13: { ! 14: term(topfix()); ! 15: } ! 16: ! 17: ex_signl() ! 18: { ! 19: int i,j; ! 20: ! 21: i = topfix(); ! 22: j = topfix() != 0; ! 23: iodone((int)signal(i,(int (*)())j)); ! 24: } ! 25: ! 26: ex_fork() ! 27: { ! 28: register pid; ! 29: register struct item *p; ! 30: ! 31: /* Note that even when a virtual fork facility is available, ! 32: * we do a true fork here -- the user might want two APL's ! 33: * running simultaneously. ! 34: */ ! 35: ! 36: if ((pid = FORKF(0)) == -1) ! 37: error("couldn't fork"); ! 38: pop(); ! 39: iodone(pid); ! 40: } ! 41: ! 42: ex_wait() ! 43: { ! 44: register struct item *p; ! 45: register (*sig)(), pid; ! 46: int s; ! 47: ! 48: sig = signal(SIGINT, SIG_IGN); ! 49: pid = wait(&s); ! 50: signal(SIGINT, sig); ! 51: p = newdat(DA, 1, 3); ! 52: p->datap[0] = pid; ! 53: p->datap[1] = s&0377; ! 54: p->datap[2] = (s>>8)&0377; ! 55: pop(); /* dummy arg */ ! 56: *sp++ = p; ! 57: } ! 58: ! 59: #define MAXP 20 ! 60: ! 61: ex_exec() ! 62: { ! 63: register struct item *p; ! 64: register i; ! 65: register char *cp; ! 66: int j; ! 67: char *argv[MAXP+1]; ! 68: ! 69: p = fetch1(); ! 70: if (!p->rank || p->rank > 2 || p->size > 500 || p->type != CH) ! 71: error("Lexec D"); ! 72: if (p->rank == 2){ ! 73: if (p->dim[0] > MAXP) ! 74: error("Lexec D"); ! 75: cp = (char *)(p->datap); ! 76: for(i=0; i<p->dim[0]; i++) ! 77: argv[i] = cp + i*p->dim[1]; ! 78: argv[p->dim[0]] = 0; ! 79: } else { ! 80: cp = (char *)(p->datap); ! 81: for(i=j=0; i < MAXP && cp < (char *)(p->datap)+p->size; cp++) ! 82: if (!*cp) ! 83: j = 0; ! 84: else if (!j){ ! 85: j = 1; ! 86: argv[i++] = (char *)cp; ! 87: } ! 88: if (i == MAXP || *--cp) ! 89: error("Lexec D"); ! 90: argv[i] = 0; ! 91: } ! 92: execv(argv[0], &argv[1]); ! 93: pop(); ! 94: p = newdat(DA,0,0); ! 95: *sp++ = p; ! 96: } ! 97: ! 98: ex_chdir() ! 99: { ! 100: iodone(chdir(iofname())); ! 101: } ! 102: ! 103: ex_write() ! 104: { ! 105: register int fd, m; ! 106: register struct item *p; ! 107: int mult; /* Multiplier (data size) */ ! 108: ! 109: fd = topfix(); ! 110: p = fetch1(); ! 111: if(p->type != CH && p->type != DA) ! 112: error("Lwrite D"); ! 113: mult = p->type == CH ? 1 : sizeof datum; ! 114: m = WRITEF(fd, p->datap, p->size * mult) / mult; ! 115: #ifdef NBUF ! 116: newbuf(files[fd].fd_buf, fd); /* Flush output buffer */ ! 117: #endif ! 118: pop(); ! 119: iodone(m); ! 120: } ! 121: ! 122: ex_creat() ! 123: { ! 124: register m; ! 125: ! 126: m = topfix(); ! 127: iodone(CREATF(iofname(), m)); ! 128: } ! 129: ! 130: ex_open() ! 131: { ! 132: register struct item *p; ! 133: register m; ! 134: ! 135: m = topfix(); ! 136: iodone(OPENF(iofname(), m)); ! 137: } ! 138: ! 139: ex_seek() ! 140: { ! 141: register struct item *p; ! 142: register int k1, k3; ! 143: long k2; ! 144: ! 145: p = fetch1(); ! 146: if(p->type != DA || p->rank != 1 || p->size != 3) ! 147: error("Lseek D"); ! 148: k1 = p->datap[0]; ! 149: k2 = p->datap[1]; ! 150: k3 = p->datap[2]; ! 151: k1 = SEEKF(k1, k2, k3); ! 152: pop(); ! 153: iodone(k1); ! 154: } ! 155: ! 156: ex_close() ! 157: { ! 158: iodone(CLOSEF(topfix())); ! 159: } ! 160: ! 161: ex_pipe() ! 162: { ! 163: register struct item *p; ! 164: int pp[2]; ! 165: ! 166: if(pipe(pp) == -1) ! 167: p = newdat(DA, 1, 0); ! 168: else { ! 169: #ifdef NBUF ! 170: openup(pp[0]); /* Set up for I/O */ ! 171: openup(pp[1]); ! 172: #endif ! 173: p = newdat(DA, 1, 2); ! 174: p->datap[0] = pp[0]; ! 175: p->datap[1] = pp[1]; ! 176: } ! 177: pop(); ! 178: *sp++ = p; ! 179: } ! 180: ! 181: ex_read() ! 182: { ! 183: register struct item *p, *q; ! 184: int fd, nb, c; ! 185: ! 186: fd = topfix(); ! 187: nb = topfix(); ! 188: p = newdat(CH, 1, nb); ! 189: c = READF(fd, p->datap, nb); ! 190: if(c != nb){ ! 191: q = p; ! 192: if(c <= 0) ! 193: p = newdat(CH, 1, 0); ! 194: else { ! 195: p = newdat(CH, 1, c); ! 196: copy(CH, q->datap, p->datap, c); ! 197: } ! 198: dealloc(q); ! 199: } ! 200: *sp++ = p; ! 201: } ! 202: ! 203: ex_unlink() ! 204: { ! 205: iodone(unlink(iofname())); ! 206: } ! 207: ! 208: ex_kill() ! 209: { ! 210: register pid, signo; ! 211: ! 212: pid = topfix(); ! 213: signo = topfix(); ! 214: kill(pid, signo); ! 215: *sp++ = newdat(DA, 1, 0); ! 216: } ! 217: ! 218: ex_rd() ! 219: { ! 220: /* ! 221: * note: ! 222: * an empty line is converted to NULL. ! 223: * no '\n' chars are returned. ! 224: */ ! 225: char buf[200]; ! 226: register struct item *p; ! 227: register fd, i; ! 228: ! 229: fd = topfix(); ! 230: i = 0; ! 231: while((READF(fd, &buf[i], 1) == 1) && i < 200 && buf[i] != '\n') ! 232: i++; ! 233: if(i == 200) ! 234: error("Lrd D"); ! 235: if(i > 0){ ! 236: p = newdat(CH, 1, i); ! 237: copy(CH, buf, p->datap, i); ! 238: } else ! 239: p = newdat(CH, 1, 0); ! 240: *sp++ = p; ! 241: } ! 242: ! 243: ex_dup() ! 244: { ! 245: iodone(DUPF(topfix())); ! 246: } ! 247: ! 248: ex_ap() ! 249: { ! 250: register i, fd; ! 251: register struct item *p; ! 252: ! 253: fd = topfix(); ! 254: p = fetch1(); ! 255: SEEKF(fd, 0L, 2); ! 256: fappend(fd, p); ! 257: if(p->rank == 1) ! 258: WRITEF(fd, "\n", 1); ! 259: #ifdef NBUF ! 260: newbuf(files[fd].fd_buf, fd); /* Flush buffer */ ! 261: #endif ! 262: pop(); ! 263: *sp++ = newdat(DA, 1, 0); ! 264: } ! 265: ! 266: ex_float() ! 267: { ! 268: ! 269: /* Convert characters into either double-precision (apl) ! 270: * or single-precision (apl2) format. (Involves only ! 271: * changing the data type and size declarations. ! 272: */ ! 273: ! 274: register struct item *p; ! 275: ! 276: p = fetch1(); /* Get variable descriptor */ ! 277: if (p->type != CH) /* Must be characters */ ! 278: error("topval C"); ! 279: if (p->rank == 0 /* Scalar */ ! 280: || p->dim[(p->rank) - 1] % sizeof datum) /* Bad size */ ! 281: error("float D"); ! 282: p->dim[p->rank - 1] /= sizeof datum; /* Reduce dimensions */ ! 283: p->size /= sizeof datum; /* Reduce size */ ! 284: p->type = DA; /* Change data type */ ! 285: } ! 286: ! 287: iodone(ok) ! 288: { ! 289: register struct item *p; ! 290: ! 291: p = newdat(DA, 0, 1); ! 292: p->datap[0] = ok; ! 293: *sp++ = p; ! 294: } ! 295: ! 296: char * ! 297: iofname(m) ! 298: { ! 299: register struct item *p; ! 300: char b[200]; ! 301: ! 302: p = fetch1(); ! 303: if(p->type != CH || p->rank > 1) ! 304: error("file name D"); ! 305: copy(CH, p->datap, b, p->size); ! 306: b[p->size] = 0; ! 307: pop(); ! 308: return(b); ! 309: } ! 310: fappend(fd, ap) ! 311: struct item *ap; ! 312: { ! 313: register struct item *p; ! 314: register char *p1; ! 315: int i, dim0, dim1, sb[32]; ! 316: char b[200]; ! 317: ! 318: p = ap; ! 319: if((p->rank != 2 && p->rank != 1) || p->type != CH) ! 320: error("file append D"); ! 321: dim1 = p->dim[1]; ! 322: dim0 = p->dim[0]; ! 323: if(p->rank == 1) ! 324: dim1 = dim0; ! 325: p1 = (char *)(p->datap); ! 326: if(p->rank == 2) ! 327: for(i=0; i<dim0; i++){ ! 328: copy(CH, p1, b, dim1); ! 329: p1 += dim1; ! 330: b[ dim1 ] = '\n'; ! 331: WRITEF(fd, b, dim1+1); ! 332: } ! 333: else ! 334: WRITEF(fd, p->datap, dim0); ! 335: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.