![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to al.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 40BSD / cmd / apl|
Return to al.c CVS log | Up to [CSRG BSD Unix] / 40BSD / cmd / apl |
1.1 root 1: #
2:
3: /*
4: * monadic epsilon and encode /rww
5: */
6:
7: #include "apl.h"
8:
9: ex_meps()
10: {
11: register struct item *p;
12: register i,j;
13: struct item *mark;
14:
15: char *a,*b,*c;
16: int dim0,dim1;
17: int xpcp;
18:
19: p = fetch1();
20: if(p->rank>2 || p->type!=CH)
21: error("execute C");
22: if(!p->size) {
23: pop();
24: push(newdat(DA,1,0));
25: return;
26: }
27: b = p->datap;
28: dim0 = p->rank<2 ? 1 : p->dim[0];
29: dim1 = p->rank<2 ? p->size : p->dim[1];
30: a = alloc(dim1+1);
31: xpcp = pcp;
32: mark = sp;
33: for(i=0; i<dim0; i++){
34: for(j=0; j<dim1; j++)
35: a[j] = b[j];
36: a[j] = '\n';
37: c = compile(a,1);
38: execute(c);
39: afree(c);
40: b =+ dim1;
41: if(i < dim0-1)
42: pop();
43: }
44: afree(a);
45: pcp = xpcp;
46: while(sp>mark)
47: dealloc(*--sp);
48: pop();
49: push(newdat(DA,1,0));
50: }
51:
52: ex_menc()
53: {
54: struct item *p;
55:
56: p = fetch1();
57: if(p->type == CH)
58: menc0();
59: else
60: menc1();
61: }
62:
63: menc0() /* dredge up a function and put it into an array*/
64: {
65: int oifile;
66: char name[NAMS];
67: char *c, *c2;
68: struct nlist *np;
69: struct item *p;
70: int len, dim0, dim1;
71: register i;
72: register char *dp;
73:
74: p = fetch1();
75: if(p->size == 0 || p->rank >1 || p->size >= NAMS)
76: error("menc C");
77: /* set up the name in search format */
78: copy(CH, p->datap, name, p->size);
79: name[p->size] = '\0';
80: /* search for name among the functions */
81: for(np = nlist; np->namep; np++)
82: if(equal(np->namep,name))
83: break;
84: /* if not found then domain error */
85: if(!np->namep)
86: error("menc D");
87: /* set up new array */
88: dim0 = 0;
89: dim1 = 0;
90: oifile = ifile;
91: ifile = dup(wfile);
92: lseek(ifile, np->label, 0); /* look up function */
93: /* compute max width and height */
94: while(c2 = c = rline(0))
95: { while(*c2++ != '\n');
96: dim0++;
97: len = c2 - c - 1;
98: dim1 = dim1 < len ? len : dim1;
99: afree(c);
100: }
101: afree(p); /* release old variable */
102: /* create new array and put function in */
103: p = newdat(CH, 2, dim0*dim1);
104: p->rank = 2;
105: p->dim[0] = dim0;
106: p->dim[1] = dim1;
107: dp = p->datap;
108: lseek(ifile, np->label, 0);
109: while(c2 = c = rline(0))
110: { for(i=0; i<dim1; i++)
111: if(*c != '\n')
112: *dp++ = *c++;
113: else
114: *dp++ = ' '; /* fill w/blanks*/
115: afree(c2);
116: }
117: /* put the new array on the stack */
118: push(p);
119: /* reset the current file */
120: ifile = oifile;
121: }
122:
123: menc1()/* change numbers into characters */
124: {
125: struct item *p, *q;
126: register i,j,numsz;
127: data *dp;
128: int total,param[4];
129:
130: /* zeroize size information vector */
131: for(i=0; i<4; i++)
132: param[i] = 0;
133: /* pick up the argument */
134: p = fetch1();
135: dp = p->datap;
136: /* find the maximum # of chars in any # */
137: for(i=0; i<p->size; i++)
138: epr1(*dp++, param);
139: numsz = param[1] + param[2] + !!param[2] + param[3] + 1;
140: /* rowsize is max # size x last dim */
141: rowsz = p->rank ? p->dim[p->rank-1] : 1;
142: rowsz *= numsz;
143: /* row size x # of rows(incl blank)*/
144: total = p->size * numsz;
145: for(j=i=0; i<p->rank; i++)
146: if(p->dim[i] != 1)
147: if(j++ > 1)
148: total =+ rowsz;
149: /* make new data and fill with blanks */
150: q = newdat(CH, 2, total);
151: q->dim[0] = total/rowsz;
152: q->dim[1] = rowsz;
153: mencptr = q->datap;
154: for(i=0; i<total; i++)
155: *mencptr++ = ' ';
156: mencptr = q->datap;
157: /* use putchar()to fill up the array */
158: mencflg = 2;
159: ex_hprint();
160: mencflg = 0;
161: /* put it on the stack */
162: push(q);
163: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.