home *** CD-ROM | disk | FTP | other *** search
/ Magazyn Amiga 13 / MA_Cover_13.bin / source / c / apl / az.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-11-23  |  4.5 KB  |  304 lines
  1. #include "apl.h"
  2. #include <signal.h>
  3.  
  4. char *iofname();
  5.  
  6.  
  7. /*
  8.  * misc. other routines
  9.  */
  10.  
  11. ex_exit()
  12. {
  13.     term(topfix());
  14. }
  15.  
  16. ex_signl()
  17. {
  18.     int i,j;
  19.  
  20.     i = topfix();
  21.     j = topfix() != 0;
  22.     iodone((int)signal(i,(int (*)())j));
  23. }
  24.  
  25. ex_fork()
  26. {
  27.     int pid;
  28.     struct item *p;
  29.  
  30.     if ((pid = fork(0)) == -1) error("couldn't fork");
  31.     pop();
  32.     iodone(pid);
  33. }
  34.  
  35. ex_wait()
  36. {
  37.     struct item *p;
  38.     int (*sig)(), pid;
  39.     int s;
  40.  
  41.     sig = signal(SIGINT, SIG_IGN);
  42.     pid = wait(&s);
  43.     signal(SIGINT, sig);
  44.     p = newdat(DA, 1, 3);
  45.     p->datap[0] = pid;
  46.     p->datap[1] = s&0377;
  47.     p->datap[2] = (s>>8)&0377;
  48.     pop();        /* dummy arg */
  49.     *sp++ = p;
  50. }
  51.  
  52. #define MAXP 20
  53.  
  54. ex_exec()
  55. {
  56.     struct item *p;
  57.     int i, j;
  58.     char *cp, *argv[MAXP+1];
  59.  
  60.     p = fetch1();
  61.     if (!p->rank || p->rank > 2 || p->size > 500 || p->type != CH) error("Lexec D");
  62.     if (p->rank == 2){
  63.         if (p->dim[0] > MAXP) error("Lexec D");
  64.         cp = (char *)(p->datap);
  65.         for(i=0; i<p->dim[0]; i++) argv[i] = cp + i*p->dim[1];
  66.         argv[p->dim[0]] = 0;
  67.     }
  68.     else {
  69.         cp = (char *)(p->datap);
  70.         for(i=j=0; i < MAXP && cp < (char *)(p->datap)+p->size; cp++) {
  71.             if (!*cp) j = 0;
  72.             else if (!j){
  73.                 j = 1;
  74.                 argv[i++] = (char *)cp;
  75.             }
  76.         }
  77.         if (i == MAXP || *--cp) error("Lexec D");
  78.         argv[i] = 0;
  79.     }
  80.     execv(argv[0], &argv[1]);
  81.     pop();
  82.     p = newdat(DA,0,0);
  83.     *sp++ = p;
  84. }
  85.  
  86. ex_chdir()
  87. {
  88.     iodone(chdir(iofname()));
  89. }
  90.  
  91. ex_write()
  92. {
  93.     int fd, m;
  94.     struct item *p;
  95.     int mult;            /* Multiplier (data size) */
  96.  
  97.     fd = topfix();
  98.     p = fetch1();
  99.     if(p->type != CH && p->type != DA) error("Lwrite D");
  100.     mult = p->type == CH ? 1 : sizeof datum;
  101.     m = write(fd, p->datap, p->size * mult) / mult;
  102.     pop();
  103.     iodone(m);
  104. }
  105.  
  106. ex_creat()
  107. {
  108.     int m;
  109.  
  110.     m = topfix();
  111.     iodone(creat(iofname(), m));
  112. }
  113.  
  114. ex_open()
  115. {
  116.     struct item *p;
  117.     int m;
  118.  
  119.     m = topfix();
  120.     iodone(open(iofname(), m));
  121. }
  122.  
  123. ex_seek()
  124. {
  125.     struct item *p;
  126.     int k1, k3;
  127.     long k2;
  128.  
  129.     p = fetch1();
  130.     if(p->type != DA || p->rank != 1 || p->size != 3) error("Lseek D");
  131.     k1 = p->datap[0];
  132.     k2 = p->datap[1];
  133.     k3 = p->datap[2];
  134.     k1 = lseek(k1, k2, k3);
  135.     pop();
  136.     iodone(k1);
  137. }
  138.  
  139. ex_close()
  140. {
  141.     iodone(close(topfix()));
  142. }
  143.  
  144. ex_pipe()
  145. {
  146.     struct item *p;
  147.     int pp[2];
  148.  
  149.     if(pipe(pp) == -1) p = newdat(DA, 1, 0);
  150.     else {
  151.         p = newdat(DA, 1, 2);
  152.         p->datap[0] = pp[0];
  153.         p->datap[1] = pp[1];
  154.     }
  155.     pop();
  156.     *sp++ = p;
  157. }
  158.  
  159. ex_read()
  160. {
  161.     struct item *p, *q;
  162.     int fd, nb, c;
  163.  
  164.     fd = topfix();
  165.     nb = topfix();
  166.     p = newdat(CH, 1, nb);
  167.     c = read(fd, p->datap, nb);
  168.     if(c != nb){
  169.         q = p;
  170.         if(c <= 0) p = newdat(CH, 1, 0);
  171.         else {
  172.             p = newdat(CH, 1, c);
  173.             copy(CH, q->datap, p->datap, c);
  174.         }
  175.         dealloc(q);
  176.     }
  177.     *sp++ = p;
  178. }
  179.  
  180. ex_unlink()
  181. {
  182.     iodone(unlink(iofname()));
  183. }
  184.  
  185. ex_kill()
  186. {
  187.     int pid, signo;
  188.  
  189.     pid = topfix();
  190.     signo = topfix();
  191.     kill(pid, signo);
  192.     *sp++ = newdat(DA, 1, 0);
  193. }
  194.  
  195. ex_rd()
  196. {
  197.     /*
  198.      * note:
  199.      * an empty line is converted to NULL.
  200.      * no '\n' chars are returned.
  201.      */
  202.     char buf[200];
  203.     struct item *p;
  204.     int fd, i;
  205.  
  206.     fd = topfix();
  207.     i = 0;
  208.     while((read(fd, &buf[i], 1) == 1) && i < 200 && buf[i] != '\n') i++;
  209.     if(i == 200) error("Lrd D");
  210.     if(i > 0){
  211.         p = newdat(CH, 1, i);
  212.         copy(CH, buf, p->datap, i);
  213.     }
  214.     else p = newdat(CH, 1, 0);
  215.     *sp++ = p;
  216. }
  217.  
  218. ex_dup()
  219. {
  220.     iodone(dup(topfix()));
  221. }
  222.  
  223. ex_ap()
  224. {
  225.     int i, fd;
  226.     struct item *p;
  227.  
  228.     fd = topfix();
  229.     p = fetch1();
  230.     lseek(fd, 0L, 2);
  231.     fappend(fd, p);
  232.     if(p->rank == 1) write(fd, "\n", 1);
  233.     pop();
  234.     *sp++ = newdat(DA, 1, 0);
  235. }
  236.  
  237. ex_float()
  238. {
  239.  
  240.     /* Convert characters into either double-precision (apl)
  241.      * or single-precision (apl2) format.  (Involves only
  242.      * changing the data type and size declarations.
  243.      */
  244.  
  245.     struct item *p;
  246.  
  247.     p = fetch1();                                    /* Get variable descriptor */
  248.     if (p->type != CH) error("topval C");            /* Must be characters */
  249.     if (p->rank == 0                                 /* Scalar */
  250.         || p->dim[(p->rank) - 1] % sizeof datum)    /* Bad size */
  251.             error("float D");
  252.     p->dim[p->rank - 1] /= sizeof datum;            /* Reduce dimensions */
  253.     p->size /= sizeof datum;                        /* Reduce size */
  254.     p->type = DA;                                    /* Change data type */
  255. }
  256.  
  257. iodone(ok)
  258. {
  259.     struct item *p;
  260.  
  261.     p = newdat(DA, 0, 1);
  262.     p->datap[0] = ok;
  263.     *sp++ = p;
  264. }
  265.  
  266. char *
  267. iofname(m)
  268. {
  269.     struct item *p;
  270.     char b[200];
  271.  
  272.     p = fetch1();
  273.     if(p->type != CH || p->rank > 1) error("file name D");
  274.     copy(CH, p->datap, b, p->size);
  275.     b[p->size] = 0;
  276.     pop();
  277.     return(b);
  278. }
  279.  
  280. fappend(fd, ap)
  281. struct item *ap;
  282. {
  283.     struct item *p;
  284.     char *p1;
  285.     int i, dim0, dim1, sb[32];
  286.     char b[200];
  287.  
  288.     p = ap;
  289.     if((p->rank != 2 && p->rank != 1) || p->type != CH) error("file append D");
  290.     dim1 = p->dim[1];
  291.     dim0 = p->dim[0];
  292.     if(p->rank == 1) dim1 = dim0;
  293.     p1 = (char *)(p->datap);
  294.     if(p->rank == 2) {
  295.         for(i=0; i<dim0; i++){
  296.             copy(CH, p1, b, dim1);
  297.             p1 += dim1;
  298.             b[ dim1 ] = '\n';
  299.             write(fd, b, dim1+1);
  300.         }
  301.     }
  302.     else write(fd, p->datap, dim0);
  303. }
  304.