![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to aj.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 aj.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / apl / src |
1.1 root 1: static char Sccsid[] = "aj.c @(#)aj.c 1.2 10/1/82 Berkeley ";
2: #include "apl.h"
3: #include <signal.h>
4:
5: #ifdef vax
6: #define WSMESG "can't load pdp-11 workspace"
7: #else
8: #define WSMESG "can't load vax workspace"
9: #endif
10:
11:
12: clear()
13: {
14: register struct nlist *n;
15:
16: for(n=nlist; n->namep; n++) {
17: n->use = 0;
18: n->itemp = 0;
19: n->namep = 0;
20: }
21: thread.iorg = 1;
22: srand(thread.rl = 1);
23: thread.width = 72;
24: thread.fuzz = 1.0e-13;
25: afreset(); /* release all dynamic memory */
26: gsip = 0; /* reset state indicator */
27: }
28:
29: lsize(s)
30: char *s;
31: {
32: register i;
33: register char *p;
34:
35: i=1;
36: p=s;
37: while (*p++) i++;
38: return(i);
39: }
40:
41: isize(ip)
42: struct item *ip;
43: {
44: register struct item *p;
45: register i;
46:
47: p=ip;
48: i = sizeof *p - (MRANK-p->rank)*SINT;
49: if(p->type == DA)
50: i += p->size*SDAT; else
51: if(p->type == CH)
52: i += p->size;
53: return(i);
54: }
55:
56: wsload(ffile)
57: {
58: struct item *convrt();
59: char name[NAMS];
60: union uci iz;
61: register i;
62: register struct nlist *n;
63: register struct item *p;
64: char c;
65: int dconv;
66: struct {
67: int word;
68: };
69:
70: iz.i = 0;
71: /* Check for correct magic number */
72: READF(ffile,&iz,sizeof iz);
73: iz.i &= 0177777; /* Zap high bits */
74: if((iz.i|1) != (MAGIC|1)){
75: barf:
76: CLOSEF(ffile);
77: if (((iz.i|1)^2) == (MAGIC|1))
78: error(WSMESG);
79: else
80: error("bad ws file format");
81: }
82: if(iz.i > MAGIC){
83: printf("single data converted to double\n");
84: dconv = 2;
85: } else if(iz.i < MAGIC){
86: printf("double data converted to single\n");
87: dconv = 1;
88: } else
89: dconv = 0;
90: READF(ffile,&thread,sizeof thread);
91: while(READF(ffile,&iz,sizeof iz) == sizeof iz){
92: i = iz.cv[1];
93: /* read name of vbl or fn */
94: READF(ffile,name,i);
95: for(n=nlist; n->namep; n++)
96: if(equal(name, n->namep)){
97: erase(n);
98: goto hokay;
99: }
100: n->namep = alloc(i);
101: copy(CH,name,n->namep,i);
102: hokay:
103: n->use = iz.cv[0];
104: n->type = LV;
105: switch(n->use) {
106: default:
107: goto barf;
108:
109: case DA:
110: READF(ffile,&iz,sizeof iz);
111: p=(struct item *)alloc(iz.i);
112: READF(ffile,p,iz.i);
113: p->datap = (data *)&p->dim[p->rank]; /*make absolute*/
114: /*
115: * convert data type if neccessary
116: */
117: n->itemp = convrt(dconv,p);
118: continue;
119: case NF:
120: case MF:
121: case DF:
122: n->itemp = 0;
123: n->label = SEEKF(wfile, 0L, 2);
124: do {
125: if(READF(ffile,&c,1) != 1)
126: error("wsload eof");
127: WRITEF(wfile,&c,1);
128: } while(c != 0);
129: }
130: }
131: fdat(ffile);
132: CLOSEF(ffile);
133: }
134:
135: wssave(ffile)
136: {
137: register struct nlist *n;
138:
139: nsave(ffile, 0);
140: for(n=nlist; n->namep; n++)
141: nsave(ffile, n);
142: fdat(ffile);
143: CLOSEF(ffile);
144: }
145:
146: vsave(fd)
147: {
148: register struct nlist *n;
149: struct nlist *getnm();
150:
151: nsave(fd, 0);
152: while(n = getnm())
153: nsave(fd, n);
154: fdat(fd);
155: CLOSEF(fd);
156: }
157:
158: nsave(ffile, an)
159: struct nlist *an;
160: {
161: union uci iz;
162: register struct nlist *n;
163: register i;
164: register struct item *p;
165: char c;
166:
167: n = an;
168: if(n == 0){
169: iz.i = MAGIC;
170: WRITEF(ffile,&iz,sizeof iz);
171: WRITEF(ffile,&thread,sizeof thread);
172: return(0);
173: }
174:
175: if(n->use == 0 || (n->use == DA && n->itemp == 0))
176: return(0);
177: iz.cv[0] = n->use;
178: iz.cv[1] = i = lsize(n->namep);
179: #ifdef vax
180: iz.cv[2] = iz.cv[3] = 0;
181: #endif
182: WRITEF(ffile,&iz,sizeof iz);
183: WRITEF(ffile,n->namep,i);
184:
185: switch(n->use) {
186: default:
187: CLOSEF(ffile);
188: error("save B");
189: case DA:
190: p = n->itemp;
191: iz.i = i = isize(p);
192: ((struct nlist *)p)->label -= (int)p;
193: WRITEF(ffile,&iz,sizeof iz);
194: WRITEF(ffile,p,i);
195: ((struct nlist *)p)->label += (int)p;
196: break;
197: case NF:
198: case MF:
199: case DF:
200: SEEKF(wfile,(long)n->label,0);
201: do {
202: READF(wfile,&c,1);
203: WRITEF(ffile,&c,1);
204: } while(c != 0);
205: }
206: return(0);
207: }
208:
209: struct nlist *
210: getnm()
211: {
212: char name[100];
213: register char *p;
214: register struct nlist *n;
215: register c;
216:
217: while(1){
218: printf("variable name? ");
219: c = READF(1, name, 100);
220: if(c <= 1)
221: return(0);
222: name[c-1] = 0;
223: for(n=nlist; n->namep; n++)
224: if(equal(name, n->namep))
225: return(n);
226: printf("%s does not exist\n", name);
227: }
228: }
229:
230: #ifdef NDIR
231: listdir()
232: {
233: register pid, i;
234: register int (*oldint)();
235:
236: /* I am not AT ALL happy with the change in the directory
237: * format. Until it settles down in an official 4.2BSD
238: * distribution, just bail out and call "ls". This solution
239: * doesn't work properly with ")script" files, but eventually
240: * I hope to make it internal again.
241: * --John Bruner (06-May-82)
242: */
243:
244: oldint = signal(SIGINT, SIG_IGN);
245: while ((pid=FORKF(1)) < 0)
246: sleep(5);
247: if (!pid) {
248: signal(SIGINT, SIG_DFL);
249: execl("/usr/ucb/ls", "ls", 0); /* for column output */
250: execl("/bin/ls", "ls", 0); /* last resort */
251: write(2, "Can't find \"ls\"!\n", 17);
252: exit(1);
253: }
254: while ((i=wait(0)) > 0 && i != pid);
255: signal(SIGINT, oldint);
256: }
257: #else
258: listdir()
259: {
260: register f;
261: register char *p;
262: struct direct dir;
263:
264: /* List the directory in columnar format. */
265:
266: if((f = OPENF(".",0)) < 0)
267: error("directory B");
268: while(READF(f,&dir,sizeof dir) == sizeof dir)
269: if(dir.d_ino != 0 && dir.d_name[0] != '.') {
270: if(column+10 >= thread.width)
271: printf("\n\t");
272: for(p=dir.d_name; p<dir.d_name+14 && *p; p++)
273: putchar(*p);
274: putchar('\t');
275: }
276: putchar('\n');
277: CLOSEF(f);
278: }
279: #endif
280:
281: fdat(f)
282: {
283: struct stat b;
284: register struct tm *p;
285: struct tm *localtime();
286:
287: FSTATF(f,&b);
288: p = localtime(&b.st_mtime);
289:
290: printf(" ");
291: pr2d(p->tm_hour);
292: putchar('.');
293: pr2d(p->tm_min);
294: putchar('.');
295: pr2d(p->tm_sec);
296: putchar(' ');
297: pr2d(p->tm_mon+1);
298: putchar('/');
299: pr2d(p->tm_mday);
300: putchar('/');
301: pr2d(p->tm_year);
302: }
303:
304: pr2d(i)
305: {
306: putchar(i/10+'0');
307: putchar(i % 10 + '0');
308: }
309:
310: struct item *
311: convrt(m, p)
312: struct item *p;
313: {
314: register i;
315: register float *f;
316: register double *d;
317: struct item *q;
318:
319: if (p->type == CH) return(p);
320: switch(m){
321: case 0:
322: return(p);
323:
324: case 1: /* apl to apl2 */
325: q = newdat(DA, p->rank, p->size);
326: f = (float *)q->datap;
327: d = (double *)p->datap;
328: for(i=0; i<p->size; i++)
329: *f++ = *d++;
330: break;
331:
332: case 2: /* apl2 to apl */
333: q = newdat(DA, p->rank, p->size);
334: f = (float *)p->datap;
335: d = (double *)q->datap;
336: for(i=0; i<p->size; i++)
337: *d++ = *f++;
338: break;
339: }
340: for(i=0; i<p->rank; i++)
341: q->dim[i] = p->dim[i];
342: free(p);
343: return(q);
344: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.