Commit | Line | Data |
---|---|---|
b5a92627 KT |
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*/ |