|
|
1.1 root 1: #include "apl.h"
2:
3: ex_immed()
4: {
5: register i;
6: register struct item *p;
7: register struct nlist *n;
8: double f;
9:
10: i = *pcp++;
11: switch(i) {
12:
13: default:
14: error("immed B");
15:
16: case APL:
17: setterm(0);
18: return;
19:
20: case ASCII:
21: setterm(1);
22: return;
23:
24: case DEBUG:
25: debug = ~debug;
26: return;
27:
28: case DIGITS:
29: i = topfix();
30: if(i < 1 || i > 20)
31: error("digits D");
32: aprintf("was %d\n",thread.digits);
33: thread.digits = i;
34: return;
35:
36: case ED_IT:
37: funedit(EDIT_ED);
38: return;
39:
40: case EX_IT:
41: funedit(EDIT_EX);
42: return;
43:
44: case EX_VI:
45: funedit(EDIT_VI);
46: return;
47:
48: case FUZZ:
49: i = topfix();
50: if(i <= 0) {
51: thread.fuzz = 0.;
52: return;
53: }
54: f = i;
55: thread.fuzz = exp(-f*2.3025851);
56: return;
57:
58: case ORIGIN:
59: aprintf("was %d\n",thread.iorg);
60: thread.iorg = topfix();
61: return;
62:
63: case WIDTH:
64: i = topfix();
65: if(i < 1)
66: error("width D");
67: aprintf("was %d\n",thread.width);
68: thread.width = i;
69: return;
70:
71: case READ:
72: funload(0);
73: return;
74:
75: case ERASE:
76: p = sp[-1];
77: sp--;
78: erase(p);
79: return;
80:
81: case CONTIN:
82: if((i=creat("continue",0644)) < 0)
83: error("cannot create");
84: wssave(i);
85: aprintf(" continue");
86:
87: case OFF:
88: term();
89:
90: case VARS:
91: for(n=nlist; n->namep; n++)
92: if(n->itemp && n->use == DA) {
93: if(column+8 >= thread.width)
94: aprintf("\n\t");
95: aprintf(n->namep);
96: aputchar('\t');
97: }
98: aputchar('\n');
99: return;
100:
101: /*#ifdef SOMED*/
102: case SYMBOLS:
103: {
104: int typkey, ii;
105: for(n=nlist; n->namep; n++) {
106: aputchar('\n'); aprintf(n->namep); aprintf(">\n use>\t");
107: prtype(n->use);
108: aprintf(" type>\t");
109: prtype(n->type);
110: aprintf(" labl>\t%d\n", n->label);
111: aprintf(" rank>\t%d\n", n->itemp->rank);
112: aprintf(" type>\t"); prtype(n->itemp->type);
113: aprintf(" size>\t%d\n", n->itemp->size);
114: aprintf(" indx>\t%d\n", n->itemp->index);
115: if(n->itemp->datap)
116: aprintf(" ival>\t%d\n", (int)*n->itemp->datap);
117: aprintf(" dims>\n");
118: for(ii=0; ii<n->itemp->rank; ++ii)
119: aprintf(" ;%d'>\t%d\n",ii,n->itemp->dim[ii]);
120: }
121: }
122: /*#endif*/
123:
124: case FNS:
125: for(n=nlist; n->namep; n++)
126: if(n->use == DF || n->use == MF || n->use == NF) {
127: if(column+8 >= thread.width)
128: aprintf("\n\t");
129: aprintf(n->namep);
130: aputchar('\t');
131: }
132: aputchar('\n');
133: return;
134:
135: case CLEAR:
136: clear();
137: aprintf("clear ws\n");
138: break;
139:
140: case LIB:
141: listdir();
142: return;
143:
144: case LOAD:
145: funload(2);
146: break;
147:
148: case COPY:
149: funload(1);
150: return;
151:
152: case DROPC:
153: i = 1;
154: goto drcom;
155:
156: case SAVE:
157: i = 0;
158: drcom:
159: n = sp[-1];
160: sp--;
161: if(n->type != LV)
162: error("save B");
163: if(i) {
164: unlink(n->namep);
165: return;
166: }
167: i = creat(n->namep,0644);
168: if(i < 0)
169: error("cannot create");
170: wssave(i);
171: aputchar('\n');
172: return;
173: }
174: /* special return for after clear */
175: sp = stack;
176: reset();
177: }
178:
179: /*#ifdef SOMED*/
180:
181: prtype(type)
182: {
183: int typkey;
184:
185: #define TYPCASE(type,print) case type: typkey = print; break;
186:
187: switch(type) {
188: default:
189: aprintf("%d\n", type);
190: return;
191: TYPCASE(DA,'da')
192: TYPCASE(CH,'dh')
193: TYPCASE(LV,'lv')
194: TYPCASE(QD,'qd')
195: TYPCASE(QQ,'qq')
196: TYPCASE(IN,'in')
197: TYPCASE(EL,'el')
198: TYPCASE(NF,'nf')
199: TYPCASE(MF,'mf')
200: TYPCASE(DF,'df')
201: TYPCASE(QC,'qc')
202: }
203: aputchar(typkey.c[0]); aputchar(typkey.c[1]); aputchar('\n');
204: return;
205: }
206:
207: /*#endif*/
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.