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

##### Functions

    ex_ap             X
    ex_chdir          X
    ex_close          X
    ex_creat          X
    ex_dup            X
    ex_exec           X
    ex_exit           X
    ex_float          X
    ex_fork           X
    ex_kill           X
    ex_open           X
    ex_pipe           X
    ex_rd             X
    ex_read           X
    ex_seek           X
    ex_signl          X
    ex_unlink         X
    ex_wait           X
    ex_write          X
    fappend           X
    iodone            X
    iofname           X

##### Macros

    MAXP              X

       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

ex_ap defined in line 248; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 10, 265

ex_chdir defined in line 98; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 22, 255

ex_close defined in line 156; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 24, 257

ex_creat defined in line 122; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 29, 260

ex_dup defined in line 243; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 40, 264

ex_exec defined in line 61; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 47, 251

ex_exit defined in line 12; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 48, 253

ex_float defined in line 266; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 52, 277

ex_fork defined in line 26; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 55, 249

ex_kill defined in line 208; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 69, 266

ex_open defined in line 130; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 94, 256

ex_pipe defined in line 161; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 98, 254

ex_rd defined in line 218; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 105, 263

ex_read defined in line 181; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 106, 258

ex_seek defined in line 139; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 123, 261

ex_signl defined in line 17; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 125, 276

ex_unlink defined in line 203; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 128, 262

ex_wait defined in line 42; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 129, 250

ex_write defined in line 103; used 2 times

- in /usr/src/new/OLD/apl/src/at.c line 130, 259

fappend defined in line 310; used 2 times

- in line 256
- in /usr/src/new/OLD/apl/src/ai.c line 528

iodone defined in line 287; used 10 times

- in line 23, 39, 100, 119, 127, 136, 153-158(2), 205, 245

iofname defined in line 296; used 5 times

- in line 5, 100, 127, 136, 205

#### Defined variables

Sccsid defined in line 1; never used

#### Defined macros

MAXP defined in line 59; used 4 times

- in line 67, 73, 81, 88

Last modified: 1986-10-21 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1122 |