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

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

Defined functions

Defined variables

Defined macros