repos / gbc

GBC - Go B Compiler
git clone https://github.com/xplshn/gbc.git

gbc / examples
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(&reg[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(&reg[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(&reg[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(&reg[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(&reg[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(&reg[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 : &in;
 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}