xplshn
·
2025-08-13
dc.b
B
1/* Written by LDA (seija-amanojaku)
2 * -------------------------------------------------------------------------------------------
3 * Please note that this implementation assumes a twos-complement system for checking carries.
4 * If your system does not support twos complement(?!), please don't try to go too far from the
5 * original word length (signed).
6
7 * A mostly OK, arbitary-integer calculator. Since the original dc is written in B, it is only
8 * fitting that this compiler also has its own version.
9 * Here is a test macro(C) that takes the value onto the stack and applies one step of the Collatz conjecture
10 * (divide by two if even, otherwise multiply by 3 and add 1)
11 * - "[[lT2/]sE[lT3*1+]sOsTlT2%0=ElT2%0!=O]sC"
12 * This code prints some numbers in the Fibonacci sequence (from https://esolangs.org/wiki/Dc) that are less than 5 * decimal digits (the 5 can be changed to any amount)
13 * - "1d[prdk+KdZ5>x]dsxx"
14*/
15
16WORD_LENGTH;
17BWORD_LENGTH;
18MAXWORD;
19MAXWORD_ROOT;
20
21LI_STRTYPE 1;
22LI_NUMTYPE 0;
23
24LI_TYPE 0;
25LI_NUM_LENGTH 1;
26LI_NUM_SIGN 2;
27LI_NUM_DATASTART 3; /* "Little" endian (in the way each word is stored, the overall endianness of
28 * the words themselves doesn't matter) */
29
30/* TODO: manage decimal points */
31li_ctsize() {
32 return (WORD_LENGTH);
33}
34li_ton(li) {
35 /* Considering this function "casts" to a word, this is the best you ca get */
36 if (li[LI_TYPE] == LI_NUMTYPE) {
37 if (li[LI_NUM_SIGN])
38 return (-li[LI_NUM_DATASTART]);
39 else
40 return (li[LI_NUM_DATASTART]);
41 }
42 return (0);
43}
44li_type(li) {
45 return (li[LI_TYPE]);
46}
47li_iszero(li) {
48 /* We ignore sign since -0 == +0 (can't believe I copied IEEE754) */
49 if (li_type(li) == LI_NUMTYPE) {
50 auto i; while (i < li[LI_NUM_LENGTH]) {
51 if (li[LI_NUM_DATASTART+i] != 0) return (0);
52 i++;
53 }
54 }
55 return (1);
56}
57li_xtrct2(li, i) {
58 extrn li_len2, li_xtrct2int;
59 i = li_len2(li) - i - 1;
60 return (li_xtrct2int(li, i));
61}
62li_xtrct2int(li, i) {
63 extrn li_new, li_len2;
64 auto woff, boff;
65
66 woff = i / (BWORD_LENGTH - 1);
67 boff = i % (BWORD_LENGTH - 1);
68 if (li_type(li) == LI_NUMTYPE) {
69 if (woff < li[LI_NUM_LENGTH])
70 {
71 return (li_new((li[LI_NUM_DATASTART+woff] >> boff) & 1));
72 }
73 }
74 return (li_new(0));
75}
76li_setb2(li, i, b) {
77 extrn li_new;
78 auto woff, boff;
79
80 woff = i / (BWORD_LENGTH - 1);
81 boff = i % (BWORD_LENGTH - 1);
82 if (li_type(li) == LI_NUMTYPE) {
83 if (woff < li[LI_NUM_LENGTH]) {
84 li[LI_NUM_DATASTART + woff] |= ((!!b) << boff);
85 }
86 }
87}
88li_len2(li) {
89 extrn li_new, li_free, li_mul, li_lt;
90 if (li_type(li) == LI_NUMTYPE) {
91 auto i; i = li_new(1);
92 auto r; r = 2;
93 auto two; two = li_new(2);
94 auto one; one = li_new(1);
95 while (1) {
96 auto next; next = li_mul(i, two);
97 if (!li_lt(next, li)) {
98 li_free(next);
99 goto end;
100 }
101 li_free(i);
102 i = next;
103 r++;
104 }
105end:
106 li_free(i);
107 li_free(two);
108 li_free(one);
109
110 return (r);
111 }
112 return (0);
113}
114li_newlen2(len) {
115 extrn li_newlen;
116 auto full, part;
117 full = len / BWORD_LENGTH;
118 part = len % BWORD_LENGTH;
119 if (part) part = 1;
120 return (li_newlen(full + part));
121}
122li_newlen(len) {
123 auto news, sgn;
124 extrn malloc, memset;
125 sgn = 0;
126
127 news = malloc((LI_NUM_DATASTART + len) * WORD_LENGTH);
128 news[LI_TYPE] = LI_NUMTYPE;
129 news[LI_NUM_LENGTH] = len;
130 news[LI_NUM_SIGN] = sgn;
131 memset(&news[LI_NUM_DATASTART], 0, WORD_LENGTH * len);
132
133 return (news);
134}
135li_new(nw) {
136 auto news, sgn;
137 extrn malloc;
138 sgn = 0;
139
140 if (nw < 0) { sgn = 1; nw = -nw; }
141
142 news = malloc((LI_NUM_DATASTART + 1) * WORD_LENGTH);
143 news[LI_TYPE] = LI_NUMTYPE;
144 news[LI_NUM_LENGTH] = 1;
145 news[LI_NUM_SIGN] = sgn;
146 news[LI_NUM_DATASTART] = nw;
147
148 return (news);
149}
150li_str(s) {
151 auto len, news;
152 extrn malloc, strlen, memcpy;
153
154 len = strlen(s);
155 news = malloc(len + 1 + WORD_LENGTH);
156 news[LI_TYPE] = LI_STRTYPE;
157 memcpy(news + WORD_LENGTH, s, len + 1);
158
159 return (news);
160}
161li_show(li, b) {
162 extrn printf, li_div, li_iszero, li_mod;
163 extrn li_free, li_copy, putchar;
164 if (li[LI_TYPE] == LI_NUMTYPE) {
165 auto li1; li1 = li_copy(li);
166 auto b1; b1 = li_new(b);
167
168 if (li[LI_NUM_SIGN] == 1) printf("-");
169 li1[LI_NUM_SIGN] = 0;
170 auto a, c1, c;
171
172 a = li_div(li1, b1);
173 c1 = li_mod(li1, b1);
174 if (!li_iszero(a))
175 li_show(a, b);
176
177 c = li_ton(c1) + '0';
178 li_free(c1);
179 li_free(a);
180 li_free(b1);
181 li_free(li1);
182
183 if (c > '9') c += 7;
184 putchar(c);
185 } else
186 printf("%s", &li[1]);
187}
188li_copy1(li) {
189 extrn malloc, memcpy;
190 if (li[LI_TYPE] == LI_NUMTYPE) {
191 auto nli; nli = malloc((LI_NUM_DATASTART + li[LI_NUM_LENGTH]+1) * WORD_LENGTH);
192 memcpy(nli, li, (LI_NUM_DATASTART + li[LI_NUM_LENGTH]) * WORD_LENGTH);
193 nli[li[LI_NUM_LENGTH]+LI_NUM_DATASTART] = 0;
194 nli[LI_NUM_LENGTH]++;
195 return (nli);
196 }
197 return (li_str(&li[1]));
198}
199li_grow(li) {
200 extrn malloc, memcpy, li_free;
201 if (li[LI_TYPE] == LI_NUMTYPE) {
202 auto nli; nli = malloc((LI_NUM_DATASTART + li[LI_NUM_LENGTH]+1) * WORD_LENGTH);
203 memcpy(nli, li, (LI_NUM_DATASTART + li[LI_NUM_LENGTH]) * WORD_LENGTH);
204 nli[li[LI_NUM_LENGTH]+LI_NUM_DATASTART] = 0;
205 nli[LI_NUM_LENGTH]++;
206 li_free(li);
207 return (nli);
208 }
209}
210li_copy(li) {
211 extrn malloc, memcpy;
212 if (li[LI_TYPE] == LI_NUMTYPE) {
213 auto nli; nli = malloc((LI_NUM_DATASTART + li[LI_NUM_LENGTH]) * WORD_LENGTH);
214 memcpy(nli, li, (LI_NUM_DATASTART + li[LI_NUM_LENGTH]) * WORD_LENGTH);
215 return (nli);
216 }
217 return (li_str(&li[1]));
218}
219li_add(li1, li2) {
220 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
221 auto sgn, li;
222 sgn = li1[LI_NUM_SIGN];
223 if (li2[LI_NUM_SIGN] == 1) sgn = !sgn;
224
225 if (sgn) {
226 auto x, y; /* x - y, depending on which one is negative */
227 auto maxlen, smol, large;
228 extrn memcpy;
229 if (li1[LI_NUM_SIGN] == 1) { x = li2; y = li1; }
230 else { x = li1; y = li2; }
231
232 { smol = li2; large = li1; maxlen = li1[LI_NUM_LENGTH]; }
233 if (li2[LI_NUM_LENGTH] > maxlen) {
234 maxlen = li2[LI_NUM_LENGTH];
235 smol = li1;
236 large = li2;
237 }
238 li = li_newlen(maxlen);
239 memcpy(li, x, (LI_NUM_DATASTART + x[LI_NUM_LENGTH]) * WORD_LENGTH);
240 auto i, carry; carry = 0; i = 0; while (i < maxlen) {
241 auto xw, yw, sum;
242 xw = 0; yw = 0;
243 if (i < x[LI_NUM_LENGTH]) xw = x[LI_NUM_DATASTART + i];
244 if (i < y[LI_NUM_LENGTH]) yw = y[LI_NUM_DATASTART + i];
245 sum = xw - yw - carry;
246 if (sum < 0) {
247 sum += MAXWORD + 1;
248 carry = 1;
249 } else carry = 0;
250 li[LI_NUM_DATASTART + i++] = sum;
251 }
252 if (carry) {
253 li[LI_NUM_SIGN] = 1;
254 i = 0; while (i < li[LI_NUM_LENGTH]) {
255 li[LI_NUM_DATASTART + i] =
256 (MAXWORD + 1) - li[LI_NUM_DATASTART + i] -
257 (i == 0 ? 0 : 1)
258 ;
259 i++;
260 }
261 } else li[LI_NUM_SIGN] = 0;
262 } else {
263 auto maxlen, smol, large;
264
265 { smol = li2; large = li1; maxlen = li1[LI_NUM_LENGTH]; }
266 if (li2[LI_NUM_LENGTH] > maxlen) {
267 maxlen = li2[LI_NUM_LENGTH];
268 smol = li1;
269 large = li2;
270 }
271
272 li = li_copy(large);
273 auto carry, i;
274 i = 0; carry = 0; while (i < (smol[LI_NUM_LENGTH])) {
275 auto w1; w1 = smol[LI_NUM_DATASTART + i];
276 auto w2; w2 = large[LI_NUM_DATASTART + i];
277 auto sum; sum = w1 + w2 + carry;
278
279 /* Overflow will result in negative amounts. Negative symbols mean that the top bit is
280 * set, thus, we can check if the sum is negative as a reasonable means to have a carry bit */
281 if (sum < 0) {
282 carry = 1;
283
284 /* Take the result without any carry */
285 sum = sum & MAXWORD;
286 } else carry = 0;
287 li[LI_NUM_DATASTART+i++] = sum;
288 }
289 if (carry) {
290 if (i >= li[LI_NUM_LENGTH])
291 li = li_grow(li);
292 li[LI_NUM_DATASTART+i]++;
293 }
294 }
295
296 return (li);
297 }
298 return (li_new(0));
299}
300li_sub(li1, li2) {
301 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
302 /* This function effectively piggybacks from the li_add implementation, which does check sign properly */
303 extrn li_neg, li_free;
304 auto diff;
305 li2 = li_neg(li2);
306 diff = li_add(li1, li2);
307 li_free(li2);
308 return (diff);
309 }
310 return (li_new(0));
311}
312
313/* TODO: This method of exp/multiplication is slow! */
314li_exp(li1, li2) {
315 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
316 extrn li_free, li_lt, li_get, li_mul;
317 auto sum;
318 auto one;
319 auto zero;
320
321 sum = li_new(1);
322 zero = li_new(0);
323 one = li_new(1);
324 li1 = li_copy(li1);
325 li2 = li_copy(li2);
326
327 li2[LI_NUM_SIGN] = 0;
328
329 while (li_lt(zero, li2))
330 {
331 auto nsum; nsum = li_mul(sum, li1);
332 li_free(sum);
333 sum = nsum;
334
335 auto ncount; ncount = li_add(zero, one);
336 li_free(zero);
337 zero = ncount;
338 }
339
340 if (li_iszero(sum)) sum[LI_NUM_SIGN] = 0;
341
342 li_free(li1);
343 li_free(li2);
344 li_free(zero);
345 li_free(one);
346 return (sum);
347 }
348 return (li_new(0));
349}
350li_mul(li1, li2) {
351 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
352 extrn li_free, li_lt, li_get;
353 auto sum;
354 auto one;
355 auto zero;
356 auto sgn1, sgn2, sgn;
357
358 sum = li_new(0);
359 zero = li_new(0);
360 one = li_new(1);
361
362 if (li_get(li2, li1)) {
363 auto li2t;
364 li2t = li2;
365 li2 = li1;
366 li1 = li2t;
367 }
368
369 li1 = li_copy(li1);
370 sgn1 = li1[LI_NUM_SIGN];
371 li2 = li_copy(li2);
372 sgn2 = li2[LI_NUM_SIGN];
373
374 sgn = sgn1;
375 if (sgn2) sgn = !sgn;
376
377 li1[LI_NUM_SIGN] = 0;
378 li2[LI_NUM_SIGN] = 0;
379
380 while (li_lt(zero, li2))
381 {
382 auto nsum; nsum = li_add(sum, li1);
383 li_free(sum);
384 sum = nsum;
385
386 auto ncount; ncount = li_add(zero, one);
387 li_free(zero);
388 zero = ncount;
389 }
390
391 sum[LI_NUM_SIGN] = sgn;
392 if (li_iszero(sum)) sum[LI_NUM_SIGN] = 0;
393
394 li_free(li1);
395 li_free(li2);
396 li_free(zero);
397 li_free(one);
398 return (sum);
399 }
400 return (li_new(0));
401}
402li_div(li1, li2) {
403 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
404 extrn li_get, li_add, li_sub, li_free, li_let, li_lt;
405 auto quotient, one;
406 auto sgn1, sgn2, sgn;
407
408 // Effectively li1 XOR li2
409 auto nsign; nsign = li1[LI_NUM_SIGN];
410 if (li2[LI_NUM_SIGN] == 1) nsign = !nsign;
411 one = li_new(1);
412 li1 = li_copy(li1);
413 li2 = li_copy(li2);
414 sgn1 = li1[LI_NUM_SIGN];
415 sgn2 = li2[LI_NUM_SIGN];
416 li1[LI_NUM_SIGN] = 0;
417 li2[LI_NUM_SIGN] = 0;
418
419 sgn = sgn1;
420 if (sgn2) sgn = !sgn;
421
422 auto k; k = li_len2(li1);
423 auto l; l = li_len2(li2);
424 if (k < l) {
425 // Quotient = 0, Remainder = li1
426 quotient = li_new(0);
427 } else {
428 auto kl; kl = k - l + 1;
429 auto q, r, i;
430 auto b;
431
432 // Initialisation
433 b = li_new(2);
434 q = li_new(0);
435 r = li_newlen2(l-1);
436 i = 0; while (i < (l-1)) {
437 auto alpha_i; alpha_i = li_xtrct2(li1, i);
438 auto spot; spot = l - 2 - i;
439 if (li_ton(alpha_i)) {
440 li_setb2(r, spot, 1);
441 }
442 li_free(alpha_i);
443 i++;
444 }
445 //r = li_new(8);
446 i = 0; while (i < kl) {
447 auto di, qi, ri, bi;
448 auto br, mbi, bqi;
449
450 // Compute d_i
451 br = li_mul(b, r);
452 di = li_add(br, li_xtrct2(li1, i+l-1));
453 li_free(br);
454 // Compute r_i
455 // bi is the only number [0;1] s.t d_i-mb_i<m
456 // Iff bi == 0, then d_i<m
457 if (li_lt(di, li2)) {
458 bi = li_new(0);
459 } else {
460 bi = li_new(1);
461 }
462 mbi = li_mul(bi, li2);
463 ri = li_sub(di, mbi);
464
465 // Finally, compute q_i
466 bqi = li_mul(b, q);
467 qi = li_add(bqi, bi);
468 li_free(bqi);
469
470 // Clean everything up
471 li_free(q);
472 q = qi;
473 li_free(r);
474 r = ri;
475
476 i++;
477 li_free(bi);
478 li_free(di);
479 li_free(mbi);
480 }
481 quotient = q;
482 li_free(r);
483 }
484
485 li_free(li1);
486 li_free(li2);
487 li_free(one);
488
489 quotient[LI_NUM_SIGN] = sgn;
490 if (li_iszero(quotient)) quotient[LI_NUM_SIGN] = 0;
491
492 return (quotient);
493 }
494 return (li_new(0));
495}
496li_mod(li_a, li_b) {
497 auto div, divmul, res;
498 extrn li_free;
499
500 div = li_div(li_a, li_b);
501 divmul = li_mul(div, li_b);
502 res = li_sub(li_a, divmul);
503 li_free(div);
504 li_free(divmul);
505
506 return (res);
507}
508li_gt(li1, li2) {
509 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
510 extrn li_let;
511 return (!li_let(li1, li2));
512 }
513 return (0);
514}
515li_get(li1, li2) {
516 /* TODO: Replace this with a proper bignum system */
517 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
518 extrn li_sub, li_free, printf;
519
520 /* li1 >= li2 <=> li1 - li2 >= 0 (signcheck) */
521 auto diff; diff = li_sub(li1, li2);
522 auto sgn; sgn = diff[LI_NUM_SIGN];
523 auto zro; zro = li_iszero(diff);
524
525 li_free(diff);
526 return ((sgn == 0) | zro);
527 }
528 return (0);
529}
530li_lt(li1, li2) {
531 extrn printf;
532 /* TODO: Replace this with a proper bignum system */
533 if ((li1[0] == LI_NUMTYPE) & (li2[0] == LI_NUMTYPE)) {
534 extrn li_get;
535 auto get;
536 get = !li_get(li1, li2);
537 return (get);
538 }
539 return (0);
540}
541li_let(li1, li2) {
542 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
543 extrn li_sub, li_free;
544
545 /* li1 <= li2 <=> li1 - li2 <= 0 (signcheck) */
546 auto diff; diff = li_sub(li1, li2);
547 auto sgn; sgn = diff[LI_NUM_SIGN];
548 auto zro; zro = li_iszero(diff);
549 li_free(diff);
550 return ((sgn != 0) | zro);
551 }
552 return (0);
553}
554li_eq(li1, li2) {
555 if ((li1[0] == LI_NUMTYPE) & (li1[0] == LI_NUMTYPE)) {
556 auto i, max;
557 if (li1[LI_NUM_SIGN] != li2[LI_NUM_SIGN]) return (0);
558 max = li1[LI_NUM_LENGTH];
559 if (li2[LI_NUM_LENGTH] > max) max = li2[LI_NUM_LENGTH];
560
561 i = 0; while (i < max) {
562 auto w1, w2; w1 = 0; w2 = 0;
563 if (i < li1[LI_NUM_LENGTH]) w1 = li1[LI_NUM_DATASTART + i];
564 if (i < li2[LI_NUM_LENGTH]) w2 = li2[LI_NUM_DATASTART + i];
565
566 /* nah, they're not equal */
567 if (w1 != w2) return (0);
568 i++;
569 }
570 return (1);
571 }
572 return (0);
573}
574li_neg(li) {
575 if (li[0] == LI_NUMTYPE){
576 li = li_copy(li);
577 /* TODO: Handle special cases like 0 */
578 li[LI_NUM_SIGN] = !li[LI_NUM_SIGN];
579 return (li);
580 }
581 return (li_new(0));
582}
583li_free(li) {
584 extrn free;
585 free(li);
586}
587
588/* Stack implementation */
589stack_index 0;
590stack_capacity 0;
591stack_zone 0;
592stk_init() {
593 extrn malloc;
594 stack_index = 0;
595 stack_capacity = 8;
596 stack_zone = malloc(li_ctsize() * stack_capacity);
597}
598stk_push(li) {
599 extrn realloc;
600 if (stack_index >= stack_capacity) {
601 /* TODO: Curb the growth factor! */
602 stack_capacity <<= 1;
603 stack_zone = realloc(stack_zone, stack_capacity * li_ctsize());
604 }
605 stack_zone[stack_index++] = li;
606}
607stk_pop() {
608 auto li;
609 if (stack_index == 0) {
610 extrn printf;
611 printf("?! no more values ?!\n");
612 return (li_new(0));
613 }
614
615 li = stack_zone[--stack_index];
616 return (li);
617}
618stk_clear() {
619 while (--stack_index >= 0) {
620 li_free(stack_zone[stack_index]);
621 }
622 stack_index = 0;
623}
624stk_destroy() {
625 extrn free;
626 free(stack_zone);
627}
628stk_show() {
629 auto i;
630 extrn printf;
631 extrn dc_obase;
632
633 i = stack_index - 1; while (i >= 0) {
634 li_show(stack_zone[i--], dc_obase);
635 printf("\n");
636 }
637}
638
639/* RPN operations */
640rpn_add() {
641 auto li_b, li_a, sum;
642
643 li_b = stk_pop();
644 li_a = stk_pop();
645 sum = li_add(li_a, li_b);
646 stk_push(sum);
647 li_free(li_a);
648 li_free(li_b);
649}
650rpn_sub() {
651 auto li_b, li_a, sum;
652
653 li_b = stk_pop();
654 li_a = stk_pop();
655 sum = li_sub(li_a, li_b);
656 stk_push(sum);
657 li_free(li_a);
658 li_free(li_b);
659}
660rpn_mul() {
661 auto li_b, li_a, sum;
662
663 li_b = stk_pop();
664 li_a = stk_pop();
665 sum = li_mul(li_a, li_b);
666 stk_push(sum);
667 li_free(li_a);
668 li_free(li_b);
669}
670rpn_exp() {
671 auto li_b, li_a, sum;
672 extrn li_exp;
673
674 li_b = stk_pop();
675 li_a = stk_pop();
676 sum = li_exp(li_a, li_b);
677 stk_push(sum);
678 li_free(li_a);
679 li_free(li_b);
680}
681rpn_mod() {
682 auto li_b, li_a, div, divmul, res;
683
684 li_b = stk_pop();
685 li_a = stk_pop();
686
687 div = li_div(li_a, li_b);
688 divmul = li_mul(div, li_b);
689 res = li_sub(li_a, divmul);
690 li_free(div);
691 li_free(divmul);
692 stk_push(res);
693 li_free(li_a);
694 li_free(li_b);
695}
696rpn_div() {
697 auto li_b, li_a, sum;
698 extrn printf;
699
700 li_b = stk_pop();
701 li_a = stk_pop();
702 sum = li_div(li_a, li_b);
703 stk_push(sum);
704 li_free(li_a);
705 li_free(li_b);
706}
707rpn_seti() {
708 auto li_a;
709 extrn dc_ibase;
710
711 li_a = stk_pop();
712 dc_ibase = li_ton(li_a);
713 li_free(li_a);
714}
715rpn_seto() {
716 auto li_a;
717 extrn dc_obase;
718
719 li_a = stk_pop();
720 dc_obase = li_ton(li_a);
721 li_free(li_a);
722}
723rpn_swap() {
724 auto li_b, li_a;
725
726 li_a = stk_pop();
727 li_b = stk_pop();
728
729 stk_push(li_a);
730 stk_push(li_b);
731}
732rpn_get(r) {
733 auto li_b, li_a, sum;
734 extrn readchar, execute;
735
736 li_a = stk_pop();
737 li_b = stk_pop();
738
739 if (li_get(li_a, li_b)) {
740 extrn dc_registers;
741 auto reg; reg = dc_registers[r];
742 if (li_type(reg) == LI_STRTYPE) execute(®[1]);
743 else stk_push(li_copy(reg));
744 }
745
746 li_free(li_a);
747 li_free(li_b);
748}
749rpn_gt(r) {
750 auto li_b, li_a, sum;
751 extrn readchar, execute;
752
753 li_a = stk_pop();
754 li_b = stk_pop();
755
756 if (li_gt(li_a, li_b)) {
757 extrn dc_registers;
758 auto reg; reg = dc_registers[r];
759 if (li_type(reg) == LI_STRTYPE) execute(®[1]);
760 else stk_push(li_copy(reg));
761 }
762
763 li_free(li_a);
764 li_free(li_b);
765}
766rpn_neq(r) {
767 auto li_b, li_a, sum;
768 extrn readchar, execute;
769
770 li_a = stk_pop();
771 li_b = stk_pop();
772 if (!li_eq(li_a, li_b)) {
773 extrn dc_registers;
774 auto reg; reg = dc_registers[r];
775 if (li_type(reg) == LI_STRTYPE) execute(®[1]);
776 else stk_push(li_copy(reg));
777 }
778
779 li_free(li_a);
780 li_free(li_b);
781}
782rpn_eq(r) {
783 auto li_b, li_a, sum;
784 extrn readchar, execute;
785
786 li_a = stk_pop();
787 li_b = stk_pop();
788
789 if (li_eq(li_a, li_b)) {
790 extrn dc_registers;
791 auto reg; reg = dc_registers[r];
792 if (li_type(reg) == LI_STRTYPE) execute(®[1]);
793 else stk_push(li_copy(reg));
794 }
795
796 li_free(li_a);
797 li_free(li_b);
798}
799rpn_let(r) {
800 auto li_b, li_a, sum;
801 extrn readchar, execute;
802
803 li_a = stk_pop();
804 li_b = stk_pop();
805
806 if (li_let(li_a, li_b)) {
807 extrn dc_registers;
808 auto reg; reg = dc_registers[r];
809 if (li_type(reg) == LI_STRTYPE) execute(®[1]);
810 else stk_push(li_copy(reg));
811 }
812
813 li_free(li_a);
814 li_free(li_b);
815}
816rpn_lt(r) {
817 auto li_b, li_a, sum;
818 extrn readchar, execute;
819
820 li_a = stk_pop();
821 li_b = stk_pop();
822
823 if (li_lt(li_a, li_b)) {
824 extrn dc_registers;
825 auto reg; reg = dc_registers[r];
826
827 // TODO
828 if (li_type(reg) == LI_STRTYPE) execute(®[1]);
829 else stk_push(li_copy(reg));
830 }
831
832 li_free(li_a);
833 li_free(li_b);
834}
835
836rpn_showstr(li) {
837 auto charsize; charsize = li_newlen(8);
838 auto a, c1, c;
839 li_setb2(charsize, 8, 1);
840 a = li_div(li, charsize);
841 c1 = li_mod(li, charsize);
842
843 if (!li_iszero(a))
844 rpn_showstr(a);
845 c = li_ton(c1);
846 printf("%c", c);
847
848 li_free(a);
849 li_free(c1);
850 li_free(charsize);
851}
852rpn_popshow() {
853 auto li_a, charsize;
854 extrn printf;
855 extrn dc_obase;
856
857 li_a = stk_pop();
858 if (li_type(li_a) != LI_STRTYPE)
859 rpn_showstr(li_a);
860 else
861 printf("%s", &li_a[1]);
862 li_free(li_a);
863}
864rpn_show(end) {
865 auto li_a;
866 extrn printf;
867 extrn dc_obase;
868
869 li_a = stk_pop();
870 li_show(li_a, dc_obase);
871 printf("%s", end);
872 stk_push(li_a);
873}
874rpn_pushlen() {
875 auto li_a;
876 extrn printf;
877 extrn dc_obase;
878
879 li_a = stk_pop();
880 if (li_type(li_a) == LI_STRTYPE) {
881 extrn strlen;
882 auto len; len = strlen(&li_a[1]);
883 stk_push(li_new(len));
884 } else {
885 auto len; len = 0;
886 auto ten; ten = li_new(10);
887 li_a[LI_NUM_SIGN] = 0;
888 while (li_gt(li_a, ten)) {
889 auto tmp; tmp = li_div(li_a, ten);
890 len++;
891 li_free(li_a);
892 li_a = tmp;
893 }
894 stk_push(li_new(len));
895 }
896 li_free(li_a);
897}
898rpn_dup() {
899 auto li_a;
900
901 li_a = stk_pop();
902 stk_push(li_a);
903 stk_push(li_copy(li_a));
904}
905
906/* TODO: Allow reading off a string (for macros) */
907is_alphanum(ch) {
908 if (ch >= '0') if (ch <= '9') return (1);
909 if (ch >= 'A') if (ch <= 'F') return (1);
910 return (0);
911}
912to_index(ch) {
913 if (ch >= '0') if (ch <= '9') return (ch - '0');
914 if (ch >= 'A') if (ch <= 'F') return ((ch - 'A') + 10);
915 return (0);
916}
917readchar(inp) {
918 extrn getchar, char;
919 auto c;
920 if (inp == 0) return (getchar());
921
922 c = char(*inp, 0);
923 inp[0] += 1;
924 return (c);
925}
926
927/* Measured in words */
928tmpstr[256];
929
930execute(in) {
931 extrn readchar, abort, exit;
932 extrn dc_ibase;
933 auto chr, li, b;
934 auto ptr;
935
936 ptr = in == 0 ? 0 : ∈
937 while ((chr = readchar(ptr)) != 0) {
938 if (is_alphanum(chr)) {
939 /* It's time to decode the alphanumeric character */
940 auto tmp, tmp1, tmpn;
941 li = li_new(to_index(chr));
942 b = li_new(dc_ibase);
943 while (is_alphanum((chr = readchar(ptr)))) {
944 tmp = li_mul(li, b);
945 tmpn = li_new(to_index(chr));
946 tmp1 = li_add(tmp, tmpn);
947 li_free(tmp);
948 li_free(tmpn);
949 li_free(li);
950 li = tmp1;
951 }
952 stk_push(li);
953 li_free(b);
954 } else if ((chr == '_') | (chr == '-')) {
955 /* It's time to decode the alphanumeric character */
956 auto tmp, tmp1, tmpn;
957 li = li_new(0);
958 b = li_new(dc_ibase);
959 while (is_alphanum((chr = readchar(ptr)))) {
960 tmp = li_mul(li, b);
961 tmpn = li_new(to_index(chr));
962 tmp1 = li_add(tmp, tmpn);
963 li_free(tmp);
964 li_free(tmpn);
965 li_free(li);
966 li = tmp1;
967 }
968 tmp = li_neg(li);
969 li_free(li);
970 stk_push(tmp);
971 li_free(b);
972 }
973 /* Interpret commands */
974 if (chr == '+') rpn_add();
975 else if (chr == '-') rpn_sub();
976 else if (chr == '*') rpn_mul();
977 else if (chr == '^') rpn_exp();
978 else if (chr == '/') rpn_div();
979 else if (chr == '%') rpn_mod();
980 else if (chr == 'd') rpn_dup();
981 else if (chr == 'r') rpn_swap();
982 else if (chr == 'f') stk_show();
983 else if (chr == 'c') stk_clear();
984 else if (chr == 'p') rpn_show("\n");
985 else if (chr == 'P') rpn_popshow();
986 else if (chr == 'n') { rpn_show(""); li_free(stk_pop()); }
987 else if (chr == 'k') { extrn dc_sf; li_free(dc_sf); dc_sf = stk_pop(); } /* TODO: Skalefactors */
988 else if (chr == 'K') { extrn dc_sf; stk_push(li_copy(dc_sf)); }
989 else if (chr == 'q') { return(1); }
990 else if (chr == 'Z') rpn_pushlen();
991 else if (chr == 'i') rpn_seti();
992 else if (chr == 'o') rpn_seto();
993 else if (chr == 'v') rpn_seto();
994 else if (chr == 'z') stk_push(li_new(stack_index));
995 else if (chr == '>') rpn_gt(readchar(ptr));
996 else if (chr == '<') rpn_lt(readchar(ptr));
997 else if (chr == '=') rpn_eq(readchar(ptr));
998 else if (chr == '#') {
999 while (((chr = readchar(ptr)) != '\n') & (chr != 0)) {}
1000 }
1001 else if (chr == '!') {
1002 chr = readchar(ptr);
1003 if (chr == '>') rpn_let(readchar(ptr));
1004 else if (chr == '<') rpn_get(readchar(ptr));
1005 else if (chr == '=') rpn_neq(readchar(ptr));
1006 else {
1007 extrn printf, abort;
1008 printf("?!\n");
1009 abort();
1010 }
1011 }
1012 else if (chr == 's') {
1013 extrn dc_registers;
1014
1015 chr = readchar(ptr) & 0xFF;
1016 li_free(dc_registers[chr]);
1017 dc_registers[chr] = stk_pop();
1018 }
1019 else if (chr == 'l') {
1020 extrn dc_registers;
1021
1022 chr = readchar(ptr) & 0xFF;
1023 stk_push(li_copy(dc_registers[chr]));
1024 } else if (chr == 'x') {
1025 extrn dc_registers;
1026 auto li, type;
1027
1028 li = stk_pop();
1029 type = li_type(li);
1030 if (type == LI_NUMTYPE) {
1031 stk_push(li);
1032 } else {
1033 /* Execute that string */
1034 if (execute(&li[1]) == 1)
1035 return(0);
1036 }
1037 }
1038 else if (chr == '[') {
1039 auto level;
1040 auto str;
1041 auto i;
1042 extrn printf, abort, malloc, realloc;
1043 extrn lchar;
1044
1045 level = 1; while (level > 0) {
1046 chr = readchar(ptr);
1047 if (chr == 0) {
1048 printf("?! BAD BRACES ?!\n");
1049 abort();
1050 }
1051 if (chr == '\\') {
1052 chr = readchar(ptr);
1053 lchar(tmpstr, i++, chr);
1054 lchar(tmpstr, i+0, 0 );
1055 } else {
1056 if (chr == '[') level++;
1057 if (chr == ']') level--;
1058 if (level > 0) {
1059 lchar(tmpstr, i++, chr);
1060 lchar(tmpstr, i+0, 0 );
1061 }
1062 }
1063 }
1064 stk_push(li_str(tmpstr));
1065 }
1066 else if ((chr == ' ') | (chr == '\n') | (chr == '\r')) {}
1067 else if (chr >= 128) exit(1);
1068 else if (chr == 0) return (0);
1069 else {
1070 extrn printf;
1071 printf("?! '%d %llu' ?!\n", chr, chr);
1072 }
1073
1074 }
1075 return(0);
1076}
1077
1078dc_ibase 10;
1079dc_obase 10;
1080
1081/* TODO: Represent each register as a stack of values for S and L operations */
1082dc_registers[256];
1083
1084/* TODO: Represents the _power of 10_ that numbers are scaled by */
1085dc_implicit_scale 0;
1086dc_sf;
1087
1088main() {
1089 extrn printf;
1090 auto i;
1091 WORD_LENGTH = &0[1];
1092 BWORD_LENGTH = WORD_LENGTH * 8;
1093 MAXWORD = (1<<((BWORD_LENGTH)-1))-1;
1094 i = BWORD_LENGTH>>1;
1095 MAXWORD_ROOT = (1<<(i-1))-1;
1096
1097
1098 dc_sf = li_new(0);
1099 i = 0; while (i < 256)
1100 dc_registers[i++] = li_new(0);
1101
1102 stk_init();
1103 execute(0);
1104 stk_destroy();
1105}