![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to az.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src|
Return to az.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src |
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.