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