1 /* g/n.c
2 **
3 */
4 #include "all.h"
5
6 static u3_noun _n_nock_on(u3_noun bus, u3_noun fol);
7
8 /* u3_term_io_hija(): hijack console for cooked print.
9 */
10 FILE*
11 u3_term_io_hija(void);
12
13 /* u3_term_io_loja(): release console from cooked print.
14 */
15 void
16 u3_term_io_loja(int x);
17
18 /* uL, uH: wrap hijack/lojack around fprintf.
19 **
20 ** uL(fprintf(uH, ...));
21 */
22 # define uH u3_term_io_hija()
23 # define uL(x) u3_term_io_loja(x)
24
25
26 /* _n_hint(): process hint.
27 */
28 static u3_noun
_n_hint(u3_noun zep,u3_noun hod,u3_noun bus,u3_noun nex)29 _n_hint(u3_noun zep,
30 u3_noun hod,
31 u3_noun bus,
32 u3_noun nex)
33 {
34 switch ( zep ) {
35 default: {
36 // u3m_p("weird zep", zep);
37 u3a_lose(zep);
38 u3a_lose(hod);
39
40 return _n_nock_on(bus, nex);
41 }
42
43 case c3__hunk:
44 case c3__lose:
45 case c3__mean:
46 case c3__spot: {
47 u3_noun tac = u3nc(zep, hod);
48 u3_noun pro;
49
50 u3t_push(tac);
51 #if 0
52 {
53 static int low_i;
54
55 if ( !low_i ) {
56 low_i = 1;
57 if ( 0 == (u3R->pro.nox_d % 65536ULL) ) {
58 if ( c3__spot == zep ) {
59 uL(fprintf(uH, "spot %d/%d : %d/%d\r\n",
60 u3h(u3h(u3t(hod))),
61 u3t(u3h(u3t(hod))),
62 u3h(u3t(u3t(hod))),
63 u3t(u3t(u3t(hod)))));
64 }
65 }
66 low_i = 0;
67 }
68 }
69 #endif
70 pro = _n_nock_on(bus, nex);
71 u3t_drop();
72
73 return pro;
74 }
75
76 case c3__live: {
77 if ( c3y == u3ud(hod) ) {
78 u3t_off(noc_o);
79 u3t_heck(hod);
80 u3t_on(noc_o);
81 } else {
82 u3z(hod);
83 }
84 return _n_nock_on(bus, nex);
85 }
86
87 case c3__slog: {
88 if ( !(u3C.wag_w & u3o_quiet) ) {
89 u3t_off(noc_o);
90 u3t_slog(hod);
91 u3t_on(noc_o);
92 }
93 return _n_nock_on(bus, nex);
94 }
95
96 case c3__germ: {
97 u3_noun pro = _n_nock_on(bus, nex);
98
99 if ( c3y == u3r_sing(pro, hod) ) {
100 u3z(pro); return hod;
101 } else {
102 u3z(hod); return pro;
103 }
104 }
105
106 case c3__fast: {
107 u3_noun pro = _n_nock_on(bus, nex);
108
109 u3t_off(noc_o);
110 u3j_mine(hod, u3k(pro));
111 u3t_on(noc_o);
112
113 return pro;
114 }
115
116 case c3__memo: {
117 u3z(hod);
118 #if 0
119 return _n_nock_on(bus, nex);
120 #else
121 {
122 u3_noun pro = u3z_find_2(144 + c3__nock, bus, nex);
123
124 if ( pro != u3_none ) {
125 u3z(bus); u3z(nex);
126 return pro;
127 }
128 pro = _n_nock_on(u3k(bus), u3k(nex));
129
130 if ( &(u3H->rod_u) != u3R ) {
131 u3z_save_2(144 + c3__nock, bus, nex, pro);
132 }
133
134 u3z(bus); u3z(nex);
135
136 return pro;
137 }
138 #endif
139 }
140
141 case c3__sole: {
142 u3z(hod);
143 {
144 u3_noun pro = _n_nock_on(bus, nex);
145
146 // return u3z_uniq(pro);
147 return pro;
148 }
149 }
150 }
151 }
152
153 /* _n_mush_in(): see _n_mush().
154 */
155 static u3_noun
_n_mush_in(u3_noun val)156 _n_mush_in(u3_noun val)
157 {
158 if ( c3n == u3du(val) ) {
159 return u3_nul;
160 }
161 else {
162 u3_noun h_val = u3h(val);
163 u3_noun ite;
164
165 if ( c3n == u3ud(h_val) ) {
166 ite = u3nc(c3__leaf, u3_nul);
167 } else {
168 ite = u3nc(c3__leaf, u3qe_trip(h_val));
169 }
170 return u3nc(ite, _n_mush_in(u3t(val)));
171 }
172 }
173
174 /* _n_mush(): tank from failed path request.
175 */
176 static u3_noun
_n_mush(u3_noun val)177 _n_mush(u3_noun val)
178 {
179 u3_noun pro;
180
181 pro = u3nt(c3__rose,
182 u3nt(u3nc('/', u3_nul), u3nc('/', u3_nul), u3_nul),
183 _n_mush_in(val));
184 u3z(val);
185 return pro;
186 }
187
188 /* _n_nock_on(): produce .*(bus fol). Do not virtualize.
189 */
190 static u3_noun
_n_nock_on(u3_noun bus,u3_noun fol)191 _n_nock_on(u3_noun bus, u3_noun fol)
192 {
193 u3_noun hib, gal;
194
195 while ( 1 ) {
196 hib = u3h(fol);
197 gal = u3t(fol);
198
199 #ifdef U3_CPU_DEBUG
200 u3R->pro.nox_d += 1;
201 #endif
202
203 if ( c3y == u3r_du(hib) ) {
204 u3_noun poz, riv;
205
206 poz = _n_nock_on(u3k(bus), u3k(hib));
207 riv = _n_nock_on(bus, u3k(gal));
208
209 u3a_lose(fol);
210 return u3i_cell(poz, riv);
211 }
212 else switch ( hib ) {
213 default: return u3m_bail(c3__exit);
214
215 case 0: {
216 if ( c3n == u3r_ud(gal) ) {
217 return u3m_bail(c3__exit);
218 }
219 else {
220 u3_noun pro = u3k(u3at(gal, bus));
221
222 u3a_lose(bus); u3a_lose(fol);
223 return pro;
224 }
225 }
226 c3_assert(!"not reached");
227
228 case 1: {
229 u3_noun pro = u3k(gal);
230
231 u3a_lose(bus); u3a_lose(fol);
232 return pro;
233 }
234 c3_assert(!"not reached");
235
236 case 2: {
237 u3_noun nex = _n_nock_on(u3k(bus), u3k(u3t(gal)));
238 u3_noun seb = _n_nock_on(bus, u3k(u3h(gal)));
239
240 u3a_lose(fol);
241 bus = seb;
242 fol = nex;
243 continue;
244 }
245 c3_assert(!"not reached");
246
247 case 3: {
248 u3_noun gof, pro;
249
250 gof = _n_nock_on(bus, u3k(gal));
251 pro = u3r_du(gof);
252
253 u3a_lose(gof); u3a_lose(fol);
254 return pro;
255 }
256 c3_assert(!"not reached");
257
258 case 4: {
259 u3_noun gof, pro;
260
261 gof = _n_nock_on(bus, u3k(gal));
262 pro = u3i_vint(gof);
263
264 u3a_lose(fol);
265 return pro;
266 }
267 c3_assert(!"not reached");
268
269 case 5: {
270 u3_noun wim = _n_nock_on(bus, u3k(gal));
271 u3_noun pro = u3r_sing(u3h(wim), u3t(wim));
272
273 u3a_lose(wim); u3a_lose(fol);
274 return pro;
275 }
276 c3_assert(!"not reached");
277
278 case 6: {
279 u3_noun b_gal, c_gal, d_gal;
280
281 u3x_trel(gal, &b_gal, &c_gal, &d_gal);
282 {
283 u3_noun tys = _n_nock_on(u3k(bus), u3k(b_gal));
284 u3_noun nex;
285
286 if ( 0 == tys ) {
287 nex = u3k(c_gal);
288 } else if ( 1 == tys ) {
289 nex = u3k(d_gal);
290 } else return u3m_bail(c3__exit);
291
292 u3a_lose(fol);
293 fol = nex;
294 continue;
295 }
296 }
297 c3_assert(!"not reached");
298
299 case 7: {
300 u3_noun b_gal, c_gal;
301
302 u3x_cell(gal, &b_gal, &c_gal);
303 {
304 u3_noun bod = _n_nock_on(bus, u3k(b_gal));
305 u3_noun nex = u3k(c_gal);
306
307 u3a_lose(fol);
308 bus = bod;
309 fol = nex;
310 continue;
311 }
312 }
313 c3_assert(!"not reached");
314
315 case 8: {
316 u3_noun b_gal, c_gal;
317
318 u3x_cell(gal, &b_gal, &c_gal);
319 {
320 u3_noun heb = _n_nock_on(u3k(bus), u3k(b_gal));
321 u3_noun bod = u3nc(heb, bus);
322 u3_noun nex = u3k(c_gal);
323
324 u3a_lose(fol);
325 bus = bod;
326 fol = nex;
327 continue;
328 }
329 }
330 c3_assert(!"not reached");
331
332 case 9: {
333 u3_noun b_gal, c_gal;
334
335 u3x_cell(gal, &b_gal, &c_gal);
336 {
337 u3_noun seb = _n_nock_on(bus, u3k(c_gal));
338 u3_noun pro;
339
340 u3t_off(noc_o);
341 pro = u3j_kick(seb, b_gal);
342 u3t_on(noc_o);
343
344 if ( u3_none != pro ) {
345 u3a_lose(fol);
346 return pro;
347 }
348 else {
349 if ( c3n == u3r_ud(b_gal) ) {
350 return u3m_bail(c3__exit);
351 }
352 else {
353 u3_noun nex = u3k(u3at(b_gal, seb));
354
355 u3a_lose(fol);
356 bus = seb;
357 fol = nex;
358 continue;
359 }
360 }
361 }
362 }
363 c3_assert(!"not reached");
364
365 case 10: {
366 u3_noun p_gal, q_gal;
367
368 u3x_cell(gal, &p_gal, &q_gal);
369 {
370 u3_noun zep, hod, nex;
371
372 if ( c3y == u3r_du(p_gal) ) {
373 u3_noun b_gal = u3h(p_gal);
374 u3_noun c_gal = u3t(p_gal);
375 u3_noun d_gal = q_gal;
376
377 zep = u3k(b_gal);
378 hod = _n_nock_on(u3k(bus), u3k(c_gal));
379 nex = u3k(d_gal);
380 }
381 else {
382 u3_noun b_gal = p_gal;
383 u3_noun c_gal = q_gal;
384
385 zep = u3k(b_gal);
386 hod = u3_nul;
387 nex = u3k(c_gal);
388 }
389
390 u3a_lose(fol);
391 return _n_hint(zep, hod, bus, nex);
392 }
393 }
394
395 case 11: {
396 u3_noun ref = _n_nock_on(u3k(bus), u3k(u3h(gal)));
397 u3_noun gof = _n_nock_on(bus, u3k(u3t(gal)));
398 u3_noun val;
399
400 u3t_off(noc_o);
401 val = u3m_soft_esc(ref, u3k(gof));
402 u3t_on(noc_o);
403
404 if ( !_(u3du(val)) ) {
405 u3m_bail(u3nt(1, gof, 0));
406 }
407 if ( !_(u3du(u3t(val))) ) {
408 //
409 // replace with proper error stack push
410 //
411 u3t_push(u3nc(c3__hunk, _n_mush(gof)));
412 return u3m_bail(c3__exit);
413 }
414 else {
415 u3_noun pro;
416
417 u3z(gof);
418 u3z(fol);
419 pro = u3k(u3t(u3t(val)));
420 u3z(val);
421
422 return pro;
423 }
424 }
425 c3_assert(!"not reached");
426 }
427 }
428 }
429
430 /* u3n_nock_on(): produce .*(bus fol). Do not virtualize.
431 */
432 u3_noun
u3n_nock_on(u3_noun bus,u3_noun fol)433 u3n_nock_on(u3_noun bus, u3_noun fol)
434 {
435 u3_noun pro;
436
437 u3t_on(noc_o);
438 pro = _n_nock_on(bus, fol);
439 u3t_off(noc_o);
440
441 return pro;
442 }
443
444 /* u3n_kick_on(): fire `gat` without changing the sample.
445 */
446 u3_noun
u3n_kick_on(u3_noun gat)447 u3n_kick_on(u3_noun gat)
448 {
449 return u3j_kink(gat, 2);
450 }
451
452 c3_w exc_w;
453
454 /* u3n_slam_on(): produce (gat sam).
455 */
456 u3_noun
u3n_slam_on(u3_noun gat,u3_noun sam)457 u3n_slam_on(u3_noun gat, u3_noun sam)
458 {
459 u3_noun cor = u3nc(u3k(u3h(gat)), u3nc(sam, u3k(u3t(u3t(gat)))));
460
461 #if 0
462 if ( &u3H->rod_u == u3R ) {
463 if ( exc_w == 1 ) {
464 c3_assert(0);
465 }
466 exc_w++;
467 }
468 #endif
469 u3z(gat);
470 return u3n_kick_on(cor);
471 }
472
473 /* u3n_nock_et(): produce .*(bus fol), as ++toon, in namespace.
474 */
475 u3_noun
u3n_nock_et(u3_noun gul,u3_noun bus,u3_noun fol)476 u3n_nock_et(u3_noun gul, u3_noun bus, u3_noun fol)
477 {
478 return u3m_soft_run(gul, u3n_nock_on, bus, fol);
479 }
480
481 /* u3n_slam_et(): produce (gat sam), as ++toon, in namespace.
482 */
483 u3_noun
u3n_slam_et(u3_noun gul,u3_noun gat,u3_noun sam)484 u3n_slam_et(u3_noun gul, u3_noun gat, u3_noun sam)
485 {
486 return u3m_soft_run(gul, u3n_slam_on, gat, sam);
487 }
488
489 /* u3n_nock_an(): as slam_in(), but with empty fly.
490 */
491 u3_noun
u3n_nock_an(u3_noun bus,u3_noun fol)492 u3n_nock_an(u3_noun bus, u3_noun fol)
493 {
494 u3_noun gul = u3nt(u3nt(1, 0, 0), 0, 0); // |=(a/{* *} ~)
495
496 return u3n_nock_et(gul, bus, fol);
497 }
498