/*
 * Bignum support for Edinburgh ML.
 *       When Alan Mycroft originally implemented parts of this system
 *       he has a bignum package coded in VAX assembly code.  When it
 *       came time to port the system to other machines this got left behind
 *       with just ugly error messages in its place.  My code here is
 *       a replacement, coded on a "minimal effort" basis and without
 *       serious concern about performance.  Or good style.  Or effort.
 *       Indeed it is pretty well SHODDY.
 *                                                         A C Norman 1994
 */
 
 /*
  * Bignums are represented as lists of fixnum digits.  The bottom 16
  * bits of each fixnum holds a digit in the range 0 to 9999 (by using
  * a power of 10 as radix I incur a constant-factor performance overhead
  * on arithmetic, but speed up (and simplify the coding of) IO
  * significantly).  The 0x10000 bit can be used as a sign bit.  The
  * 0x80000000 bit is reserved by ML to mark that the fixnum is immediate
  * data.  The least significant digit in a number comes at the head of a
  * a list.
  * This would be a menace if I wanted to provide bitwise AND and OR
  * operations and shifts.
  *
  * Fixnums are permitted to be in the range -(2^30-1) to (2^30-1). Note
  * that this is a SYMMETRIC range and that use of if means that the
  * negative  number represented as 0xc0000000 is not used as a fixnum. This
  * makes overflow checking marginally messier maybe, but avoids a design
  * curiosity elsewhere in ML where this value might get mangled when
  * heap images are moved between systems with positive and negative
  * pointers.
  */
  
#include <stdio.h>
#include <math.h>
#include <string.h>
#include <float.h>

#ifndef transputer
#   include <signal.h>
#endif

#include "globdefs.h"
#include "structs.h"
#include "globvars.h"
#include "io.h"
#include "bcodes.h"
#include "debug.h"

#ifdef __STDC__
#  include <stdlib.h>
#  include <errno.h>
#else
#  include <errno.h>
   extern int errno;
#endif

#ifdef sun
#  define locreg_
#else
#ifdef transputer
   /* BEWARE this next move - it makes all local vars in the fam into
      statics in the transputer, so that the C stack can fit into the
      on-chip RAM. So: NEVER say something like "locreg_ i = 42;"
      anywhere, since this will break things. */
#  define locreg_ static
#else
#  define locreg_ register
#endif
#endif

#define push(a)     *--FAM_AP = (a)
#define push2(a,b)  *--FAM_AP = (a), *--FAM_AP = (b)
#define pop(a)      (a) = *FAM_AP++
#define pop2(a,b)   (a) = *FAM_AP++, (b) = *FAM_AP++;

static int MLDiv(int X, int Y)
/* As SML defines it. See revision history in fam.c */
{
    int i;
    if (Y > 0) 
    {   if (X >= 0)  return(X / Y);
        else
        {   i = - ((-X) / Y); 
            if (X % Y) i -= 1;
            return (i);
        }
    }
    else 
    {   if (X >= 0)
        {   i = - (X / (-Y));
            if (X % Y) i -= 1; 
            return (i);
        }
        else return(-X / -Y);
    }
}

static int MLMod(int X, int Y)
/* RJG 17-may-89 - As SML defines it */
{
    int i;
    if (Y > 0) 
    {   if (X >= 0)  return(X % Y);
        else
        {   i = -((-X) % Y); 
            if (i) i += Y; 
            return (i);
        }
    } 
    else 
    {   if (X >= 0)  
        {   i = X % (-Y); 
            if (i) i += Y; 
            return (i);
        }
        else return(-((-X) % (-Y)));
    }
}

/*
 * Normally when one garbage collects it is vital to save various things
 * neatly away - but here I have arranged that I have already done that.
 */

#undef SaveRegs_
#undef RestoreRegs_
#define SaveRegs_       (void)0
#define RestoreRegs_    (void)0

LWord GenericStringOfInt(int num)
{
    locreg_ int chptr;
    int len;
    LWord tmpreg;
    char buf[12];
    if (BigNum_(num))
    {   int sign = 0;
        Cons *p;
        int d = cint_(hd_(num));
        if (d & 0x10000) sign = 1;
        len = sign;
        p = tl_(num);
        while (!Immed_(p)) d = cint_(hd_(p)), p = tl_(p), len += 4;
        d &= 0xffff;
        do len++, d = d/10; while (d != 0);
        push(num);
        AllString_(new_string, (LWord)len);
        pop(num);
        chptr = len-4;
        d = cint_(hd_(num)) & 0xffff;
        while (!Immed_(num = (int)tl_(num)))
        {   sprintf(buf, "%04d", d);
            memcpy(&stringchar_(new_string)[chptr], buf, 4);
            chptr-= 4;
            d = cint_(hd_(num)) & 0xffff;
        }
        sprintf(buf, "%d", d);
        memcpy(&stringchar_(new_string)[sign], buf, strlen(buf));
        if (sign) stringchar_(new_string)[0] = asciichar('~');
        return (LWord)new_string;
    }
    num = (int)cint_(num);
    sprintf(buf, "%d", num);
    if (num < 0) buf[0] = '~';
    len = strlen(buf);
    AllString_(new_string, (LWord)len);
    memcpy(&stringchar_(new_string)[0], buf, len);
    return (LWord)new_string;
}

int GenericRC;

LWord GenericIntOfString(LWord srcstr)
{
    LWord val, w, sign = 0;
    int i, len, d;
    char *p;
    LWord tmpreg;
    len = stringlength_(srcstr);
    GenericRC = 0;
    if (len == 0)                       /* IntOfString "" is bad */
    {   GenericRC = Exc_IntOfString;
        return 0;
    }
    p = &stringchar_(srcstr)[0];
    if ((*p == asciichar('-')) ||       /* Be generous and allow "-" too */
        (*p == asciichar('~'))) sign = 1, p++, len--;
    else if (*p == asciichar('+')) p++, len--;

    if (len == 0)  
    {   GenericRC = Exc_IntOfString;    /* IntOfString "+", "~", "-" */
        return 0; 
    }
    if (len < 11)   /* Probably a fixnum */
    {   int bignum = 0, len1 = len;
        for (val = 0; len1!=0; len1--)
        {   if (val > 0x80000000u/10u) bignum = 1;
            val = (val * 10) + *p++ - asciichar('0');
            if (val > 0x7fffffffu) bignum = 1;
        }
        if (val >= 0x40000000u) bignum = 1;
        if (sign) val = -(int)val;
        val = famint_(val);
        if (!bignum) return val;
    }
    push2(srcstr, 0);
    for (i=len; i>0; i-=4)
    {   AllCons_(new_cons, 0, *FAM_AP);
        *FAM_AP = (LWord)new_cons;
    }
    pop2(val, srcstr);
    w = val;
    p = &stringchar_(srcstr)[0];
    if ((*p == asciichar('-')) ||
        (*p == asciichar('~')) ||
        (*p == asciichar('+'))) p++;
    p = p+len-1;
    for (i=0; i<len-4; i+=4)
    {   d  = (*p-- - asciichar('0'));
        d += (*p-- - asciichar('0')) * 10;
        d += (*p-- - asciichar('0')) * 100;
        d += (*p-- - asciichar('0')) * 1000;
        if (sign) d |= 0x10000;
        hd_(val) = famint_(d);
        val = (int)tl_(val);
    }
    d = 0;
    switch (len-i)
    {
case 4:  d  = (*p-- - asciichar('0'));
         d += (*p-- - asciichar('0')) * 10;
         d += (*p-- - asciichar('0')) * 100;
         d += (*p-- - asciichar('0')) * 1000;
         break;
case 3:  d  = (*p-- - asciichar('0'));
         d += (*p-- - asciichar('0')) * 10;
         d += (*p-- - asciichar('0')) * 100;
         break;
case 2:  d  = (*p-- - asciichar('0'));
         d += (*p-- - asciichar('0')) * 10;
         break;
case 1:  d += (*p-- - asciichar('0'));
         break;
    }
    if (sign) d |= 0x10000;
    hd_(val) = famint_(d);
    return w;
}

int GenericEQ(LWord a, LWord b)
{
    if (BigNum_(a))
    {   if (BigNum_(b))
        {   while (!Immed_(a) && !Immed_(b))
            {   if (hd_(a) != hd_(b)) return 0;
                a = (LWord)tl_(a);
                b = (LWord)tl_(b);
            }
            if (!Immed_(a) || !Immed_(b)) return 0;
            else return 1;
        }
        else return 0;
    }
    else if (BigNum_(b)) return 0;
    else return (a == b);
}

int GenericGT(LWord a, LWord b)
{
    if (BigNum_(a))
    {   if (BigNum_(b))
        {   int va = cint_(hd_(a)), vb = cint_(hd_(b)), res = 0;
            int sa = va & 0x10000, sb = vb & 0x10000;
            if (sa != sb) return (sa == 0);  /* a >= 0, b < 0 */
/* Here the signs match, so I need to check magnitudes */
            if (va > vb) res = 1;
            else if (va < vb) res = -1;
            if (sa != 0) res = -res;
            for (;;)
            {   a = (LWord)tl_(a);
                b = (LWord)tl_(b);
                if (Immed_(a))
                {   if (Immed_(b))
                    {   if (res == 1) return 1;
                        else return 0;
                    }
                    else return (sa != 0);
                }
                else if (Immed_(b)) return (sa == 0);
                va = cint_(hd_(a)) & 0xffff;
                vb = cint_(hd_(b)) & 0xffff;
                if (va != vb)
                {   if (va > vb) res = 1;
                    else res = -1;
                    if (sa != 0) res = -res;
                }
            }
        }
        else
        {   int va = cint_(hd_(a)) & 0x10000 ? 0x80000000 : 0x7fffffff;
            int vb = cint_(b);
            return va > vb;
        }
    }
    else if (BigNum_(b))
    {   int va = cint_(a);
        int vb = cint_(hd_(b)) & 0x10000 ? 0x80000000 : 0x7fffffff;
        return va > vb;
    }
    else return (signed_(cint_(a)) > signed_(cint_(b)));
}

int GenericGE(LWord a, LWord b)
{
    return !GenericGT(b, a);
}

int GenericLE(LWord a, LWord b)
{
    return !GenericGT(a, b);
}

int GenericLT(LWord a, LWord b)
{
    return GenericGT(b, a);
}

LWord GenericNEG(LWord a)
{
    LWord w, w1;
    LWord tmpreg;
    int len;
/*
 * With a symmetric range for fixnums nagating can never change the
 * character of a number.
 */
    if (INum_(a)) return 2*INTZERO - a;
    w = a;
    len = 0;
    while (!Immed_(w)) len++, w = (LWord)tl_(w);
    push2(a, 0);
    while (len != 0)
    {   AllCons_(new_cons, 0, *FAM_AP);
        *FAM_AP = (LWord)new_cons;
        len--;
    }
    pop2(w, a);
    w1 = w;
    while (!Immed_(a))
    {   hd_(w) = hd_(a) ^ 0x10000;
        a = (LWord)tl_(a);
        w = (LWord)tl_(w);
    }
    return (LWord)w1;
}

/*
 * For code consistenct there are various places where I want to turn
 * a fixnum into bignum-format, even thought its value is not very big.
 * This function does what I want.
 */
static LWord small_bignum(int n)
{
    int sign = 0, d0, d1, d2;
    LWord tmpreg, w;
    if (n < 0) n = -n, sign = 1;
    d2 = n % 10000;  n = n/10000;
    d1 = n % 10000;  d0 = n/10000;
    if (sign)
    {   if (d0 != 0) d0 |= 0x10000, d1 |= 0x10000, d2 |= 0x10000;
        else if (d1 != 0) d1 |= 0x10000, d2 |= 0x10000;
        else d2 |= 0x10000;
    }
    d0 = famint_(d0);
    d1 = famint_(d1);
    d2 = famint_(d2);
    push(0);
    if (d0 != INTZERO)
    {   AllCons_(new_cons, d0, *FAM_AP);
        *FAM_AP = (LWord)new_cons;
        AllCons_(new_cons, d1, (Cons *)*FAM_AP);
        *FAM_AP = (LWord)new_cons;
        AllCons_(new_cons, d2, (Cons *)*FAM_AP);
        pop(w);
        return (LWord)new_cons;
    }
    else if (d1 != INTZERO)
    {   AllCons_(new_cons, d1, *FAM_AP);
        *FAM_AP = (LWord)new_cons;
        AllCons_(new_cons, d2, (Cons *)*FAM_AP);
        pop(w);
        return (LWord)new_cons;
    }
    else
    {   AllCons_(new_cons, d2, 0);
        pop(w);
        return (LWord)new_cons;
    }
}

/*
 * nreverse reverses its arg - destructively
 */
LWord nreverse(LWord a)
{
    LWord r = 0;
    while (!Immed_(a))
    {   LWord t = (LWord)tl_(a);
        tl_(a) = (Cons *)r;
        r = a;
        a = t;
    }
    return r;
}

/*
 * reverse_copy() makes a (non-destructive) reversed version of a list,
 * clearing away sign bits.
 */
LWord reverse_copy(LWord a)
{
    LWord tmpreg;
    push(0);
    while (!Immed_(a))
    {   push(a);
        AllCons_(new_cons, 0, 0);
        pop(a);
        hd_(new_cons) = famint_(cint_(hd_(a)) & 0xffff);
        tl_(new_cons) = (Cons *)*FAM_AP;
        *FAM_AP = (LWord)new_cons;
        a = (LWord)tl_(a);
    }
    pop(a);
    return a;
}

/*
 * add_lists treats its args as standing for unsigned values, and it
 * adds them - it knows that the result will be a bignum.
 */
LWord add_lists(LWord a, LWord b)
{
    LWord r = 0;
    int carry = 0;
    LWord tmpreg;
    while (!Immed_(a) && !Immed_(b))
    {   int d = (cint_(hd_(a)) & 0xffff) + (cint_(hd_(b)) & 0xffff) + carry;
        carry = 0;
        if (d >= 10000) d -= 10000, carry = 1;
        push2(a, b);
        push(r);
        AllCons_(new_cons, famint_(d), *FAM_AP);
        pop(r);
        pop2(b, a);
        r = (LWord)new_cons;
        a = (LWord)tl_(a);
        b = (LWord)tl_(b);
    }
    if (!Immed_(b)) a = b;
    while (!Immed_(a))
    {   int d = (cint_(hd_(a)) & 0xffff) + carry;
        carry = 0;
        if (d >= 10000) d -= 10000, carry = 1;
        push2(a, r);
        AllCons_(new_cons, famint_(d), *FAM_AP);
        pop2(r, a);
        r = (LWord)new_cons;
        a = (LWord)tl_(a);
    }
    if (carry != 0)
    {   push(r);
        AllCons_(new_cons, famint_(carry), *FAM_AP);
        pop(r);
        r = (LWord)new_cons;
    }
    return nreverse(r);
}

LWord subtract_lists(LWord a, LWord b)
{
    LWord r = 0;
    int borrow = 0, big;
    LWord tmpreg;
    while (!Immed_(a) && !Immed_(b))
    {   int d = (cint_(hd_(a)) & 0xffff) - (cint_(hd_(b)) & 0xffff) - borrow;
        borrow = 0;
        if (d < 0) d += 10000, borrow = 1;
        push2(a, b);
        push(r);
        AllCons_(new_cons, famint_(d), *FAM_AP);
        pop(r);
        pop2(b, a);
        r = (LWord)new_cons;
        a = (LWord)tl_(a);
        b = (LWord)tl_(b);
    }
/* For this function, (a) MUST be bigger than (b) */
    while (!Immed_(a))
    {   int d = (cint_(hd_(a)) & 0xffff) - borrow;
        borrow = 0;
        if (d < 0) d += 10000, borrow = 1;
        push2(a, r);
        AllCons_(new_cons, famint_(d), *FAM_AP);
        pop2(r, a);
        r = (LWord)new_cons;
        a = (LWord)tl_(a);
    }
    while (!Immed_(r) && hd_(r) == INTZERO) r = (LWord)tl_(r);
    if (Immed_(r)) return INTZERO;
    borrow = cint_(hd_(r));
    a = (LWord)tl_(r);
/*
 * Now there is of course a chance that the result was really a fixnum
 */
    big = 0;
    while (!Immed_(a))
    {   int d = cint_(hd_(a));
        a = (LWord)tl_(a);
        if ((unsigned int)borrow > 0x80000000u/10000u) { big = 1; break; }
        borrow = 10000*borrow + d;
        if (borrow < 0) { big = 1; break; }
    }
    a = famint_(borrow);
    if (!Immed_(a)) big = 1;
    if (!big) return a;
    r = nreverse(r);
    return r;
}

int GT_magnitude(LWord a, LWord b)
/* Compare magnitudes, returning -1, 0 or +1 */
{
    int va = cint_(hd_(a)), vb = cint_(hd_(b)), res = 0;
    if (va > vb) res = 1;
    else if (va < vb) res = -1;
    for (;;)
    {   a = (LWord)tl_(a);
        b = (LWord)tl_(b);
        if (Immed_(a))
        {   if (Immed_(b)) return res;
            else return -1;
        }
        else if (Immed_(b)) return 1;
        va = cint_(hd_(a)) & 0xffff;
        vb = cint_(hd_(b)) & 0xffff;
        if (va != vb)
        {   if (va > vb) res = 1;
            else res = -1;
        }
    }
}

LWord subtract_magnitudes(LWord a, LWord b)
{
    switch (GT_magnitude(a, b))
    {
case 0:  return INTZERO;
case 1:  return subtract_lists(a, b);
case -1: return GenericNEG(subtract_lists(b, a));
    }
}

LWord GenericPLUS(LWord a, LWord b)
{
    int va, vb;
    if (a == INTZERO) return b;
    else if (b == INTZERO) return a;
    else if (BigNum_(a))
    {   if (!BigNum_(b))
        {   push(a);
            b = small_bignum(cint_(b));
            pop(a);
        }
    }
    else if (BigNum_(b))
    {   push(b);
        a = small_bignum(cint_(a));
        pop(b);
    }
    else
    {   va = a + b - INTZERO;
        if (Immed_(va) && va != famint_(0xc0000000)) return va;
        a = small_bignum(cint_(a));
        push(a);
        b = small_bignum(cint_(b));
        pop(a);
    }
    va = hd_(a);
    vb = hd_(b);
    if ((va & 0x10000) == 0)
    {   if ((vb & 0x10000) == 0) return add_lists(a, b);
        else return subtract_magnitudes(a, b);
    }
    else if ((vb & 0x10000) == 0) return subtract_magnitudes(b, a);
    else
    {   a = add_lists(a, b);
        return GenericNEG(a);
    }
}

LWord GenericMINUS(LWord a, LWord b)
{
    int va, vb;
    if (a == INTZERO) return GenericNEG(b);
    else if (b == INTZERO) return a;
    else if (BigNum_(a))
    {   if (!BigNum_(b))
        {   push(a);
            b = small_bignum(cint_(b));
            pop(a);
        }
    }
    else if (BigNum_(b))
    {   push(b);
        a = small_bignum(cint_(a));
        pop(b);
    }
    else
    {   va = a - b + INTZERO;
        if (Immed_(va) && va != famint_(0xc0000000)) return va;
        a = small_bignum(cint_(a));
        push(a);
        b = small_bignum(cint_(b));
        pop(a);
    }
    va = hd_(a);
    vb = hd_(b);
    if ((va & 0x10000) == 0)
    {   if ((vb & 0x10000) == 0) return subtract_magnitudes(a, b);
        else return add_lists(a, b);
    }
    else if ((vb & 0x10000) == 0)
    {   a = add_lists(a, b);
        return GenericNEG(a);
    }
    else return a = subtract_magnitudes(b, a);
}

LWord times_digit(int d, LWord a)
{
    LWord r = 0;
    int carry = 0, d1;
    LWord tmpreg;
    while (!Immed_(a))
    {   carry = d*(cint_(hd_(a)) & 0xffff) + carry;
        d1 = carry % 10000;
        carry = carry / 10000;
        push2(a, r);
        AllCons_(new_cons, famint_(d1), *FAM_AP);
        pop2(r, a);
        r = (LWord)new_cons;
        a = (LWord)tl_(a);
    }
    if (carry != 0)
    {   push(r);
        AllCons_(new_cons, famint_(carry), *FAM_AP);
        pop(r);
        r = (LWord)new_cons;
    }
    return nreverse(r);
}

LWord GenericTIMES(LWord a, LWord b)
{
    LWord r;
    int neg;
    LWord tmpreg;
    if (!BigNum_(a))
    {   if (!BigNum_(b))
        {   int va = cint_(a), vb = cint_(b), r;
            if (va == 0 || vb == 0) return INTZERO;
            r = va*vb;
            if (r/va == vb && r%va == 0)   /* Hope this detects overflow */
            {   a = famint_(r);
                if (Immed_(a) && a != famint_(0xc0000000)) return a;
            }
            a = small_bignum(va);
            push(a);
            b = small_bignum(vb);
            pop(a);
        }
        else
        {   if (a == INTZERO) return INTZERO;
            else if (a == famint_(1)) return b;
            else if (a == famint_(-1)) return GenericNEG(b);
            push(b);
            a = small_bignum(cint_(a));
            pop(b);
        }
    }
    else if (!BigNum_(b))
    {   if (b == INTZERO) return INTZERO;
        else if (b == famint_(1)) return a;
        else if (b == famint_(-1)) return GenericNEG(b);
        push(a);
        b = small_bignum(cint_(b));
        pop(a);
    }
    neg = 0;
    if (cint_(hd_(a)) & 0x10000) neg = !neg;
    if (cint_(hd_(b)) & 0x10000) neg = !neg;
#ifdef CWIN
/*
 * Because bignum multiplication may be slow I bring forward the time
 * that I next poll the window manager (and hence potentially notice
 * a pending interrupt.
 */
    IntFlag += 0x100;
    if (IntFlag >= 0x1000) IntFlag = 0xfff;
#endif
    push(a);
    b = reverse_copy(b);
    pop(a);
    push2(a, b);
    r = times_digit(hd_(b) & 0xffff, a);
    pop2(b, a);
    b = (LWord)tl_(b);
    while (!Immed_(b))
    {   LWord w;
        push2(a, b); push(r);
        AllCons_(new_cons, 0, *FAM_AP);
        *FAM_AP = (LWord)new_cons;
        w = times_digit(hd_(b) & 0xffff, a);
        pop(r);
        r = add_lists(r, w);
        pop2(b, a);
        b = (LWord)tl_(b);
    }
    if (neg) r = GenericNEG(r);
/*
 * I will only ever have got here if the true result was NOT a fixnum. That
 * is because the result could only possible be a fixnum if both args were
 * (except is a or b is zero, and I have trapped that case).
 */
    return r;
}

/*
 * Horrible warning - the ML rules about division and mod on negative
 * numbers will NOT match the C one I expect, so the following will
 * need careful review.
 */
 
static int last_digit(LWord a)
{
    int r = 0;
    while (!Immed_(a))
    {   r = cint_(hd_(a));
        a = (LWord)tl_(a);
    }
    return r & 0xffff;
}

/* Update a to be a - q*b */
static int subtract_n_times(LWord a, LWord b, int q)
{
    int da, db, carry, borrow;
    if (Immed_(b)) return 0;
    borrow = subtract_n_times((LWord)tl_(a), (LWord)tl_(b), q);
    carry = q*cint_(hd_(b));
    da = cint_(hd_(a)) - (carry % 10000) - borrow;
    borrow = carry / 10000;
    while (da < 0) da += 10000, borrow++;
    hd_(a) = famint_(da);
    return borrow;
}

static int reversed_GE(LWord a, LWord b)
{
    if (Immed_(b)) return 1;
    else if (hd_(a) == hd_(b))
        return reversed_GE((LWord)tl_(a), (LWord)tl_(b));
    else return (cint_(hd_(a)) > cint_(hd_(b)));
}

LWord GenericDIV(LWord a, LWord b)
{
    LWord r, borrow;
    int nega, negb, lena, lenb, i, first, big;
    LWord tmpreg;
    if (!BigNum_(a))
    {   if (!BigNum_(b))
        {   if (b == famint_(-1)) return GenericNEG(a);
            else return famint_(MLDiv(cint_(a), cint_(b)));
        }
        else
        {   push(b);
            a = small_bignum(cint_(a));
            pop(b);
        }
    }
    else if (!BigNum_(b))
    {   push(a);
        b = small_bignum(cint_(b));
        pop(a);
    }
#ifdef CWIN
    IntFlag += 0x100;
    if (IntFlag >= 0x1000) IntFlag = 0xfff;
#endif
    nega = negb = 0;
    if (cint_(hd_(a)) & 0x10000) nega = 1;
    if (cint_(hd_(b)) & 0x10000) negb = 1;
    switch (GT_magnitude(a, b))
    {
case -1: if (nega == negb) return famint_(0);
         else return famint_(-1);
case 0:  if (nega == negb) return famint_(1);
         else return famint_(-1);
case 1:  break;
    }
    i = 10000/(last_digit(b) + 1);
    push(a);
    b = nreverse(times_digit(i, b));
    pop(a);
    push(b);
    a = nreverse(times_digit(i, a));
    pop(b);
/*
 * I have now scaled a and b so that the leading digit of b is reasonably
 * large. At least 5000.
 */
    for (lena=0, r=a; !Immed_(r); r=(LWord)tl_(r)) lena++;
    for (lenb=0, r=b; !Immed_(r); r=(LWord)tl_(r)) lenb++;
    push2(b, a);
    AllCons_(new_cons, INTZERO, *FAM_AP);
    pop2(a, b);
    a = (LWord)new_cons;       /* extra dummy digit on the front of a */
    r = 0;
    first = 1;
    for (i=lenb; i<=lena; i++)
    {   int num = 10000*cint_(hd_(a)) +
                  cint_(hd_(tl_(a)));
        int den = cint_(hd_(b));
        int q = num / (den+1);
        int borrow;
        borrow = subtract_n_times((LWord)tl_(a), b, q);
        hd_(a) = famint_(cint_(hd_(a)) - borrow);
        while (hd_(a) != INTZERO || reversed_GE((LWord)tl_(a), b))
        {   borrow = subtract_n_times((LWord)tl_(a), b, 1);
            hd_(a) = famint_(cint_(hd_(a)) - borrow);
            q++;
        }
        a = (LWord)tl_(a);
        if (!first || q != 0)
        {   push2(a, b); push(r);
            AllCons_(new_cons, famint_(q), *FAM_AP);
            pop(r);
            r = (LWord)new_cons;
            pop2(b, a);
            first = 0;
        }
    }
    while (!Immed_(a) && hd_(a) == INTZERO) a = (LWord)tl_(a);
    if (nega != negb && !Immed_(a))  /* need to increment r here */
    {   a = r;
        while (!Immed_(a) && hd_(a) == famint_(9999))
        {   hd_(a) = INTZERO;
            b = a;
            a = (LWord)tl_(a);
        }
        if (!Immed_(a)) hd_(a) = famint_(1+cint_(hd_(a)));
        else
        {   push2(r, b);
            AllCons_(new_cons, famint_(1), 0);
            pop2(b, r);
            tl_(b) = new_cons;
        }
    }
/*
 * Now see if the answer is really a smallnum */
    a = r = nreverse(r);
    big = 0;
    borrow = 0;
    while (!Immed_(a))
    {   int d = cint_(hd_(a));
        a = (LWord)tl_(a);
        if ((unsigned int)borrow > 0x80000000u/10000u) { big = 1; break; }
        borrow = 10000*borrow + d;
        if (borrow < 0) { big = 1; break; }
    }
    r = nreverse(r);
    a = famint_(borrow);
    if (!Immed_(a)) big = 1;
    if (!big) r = a;
    if (nega != negb) r = GenericNEG(r);
    return r;
}

LWord GenericMOD(LWord a, LWord b)
{
    LWord r;
    int nega, negb;
    LWord tmpreg;
    if (!BigNum_(a) && !BigNum_(b))
    {   if (b == famint_(-1) || b == famint_(1)) return INTZERO;
        else return famint_(MLMod(cint_(a), cint_(b)));
    }
    push2(a, b);
    r = GenericDIV(a, b);
    pop(b);
    r = GenericTIMES(r, b);
    pop(a);
    return GenericMINUS(a, r);
}

void GenericPRINT(LWord a)
{
    int num;
    if (BigNum_(a)) 
    {   LWord p;
        if (cint_(hd_(a)) & 0x10000) printf("~");
        a = nreverse(a);
        printf("%d", cint_(hd_(a)) & 0xffff);
        for (p=(LWord)tl_(a); !Immed_(p); p=(LWord)tl_(p))
            printf("%04d", cint_(hd_(p)) & 0xffff);
        a = nreverse(a);
    }
    else
    {   num = signed_(cint_(a));
        if (num < 0) { printf("~"); num = -num; }
        printf("%ld", num);
    }
}



LWord GenericTWO(int n)
{
    LWord r;
    if (n == 0) return famint_(1);
    r = GenericTWO(n/2);
    r = GenericTIMES(r, r);
    if (n & 1) r = GenericTIMES(r, famint_(2));
    return r;
}

LWord GenericFLOOR(double a)
{
    int i, neg = 0;
    unsigned int d0, d1, d2, d3, c;
    int n0, n1, n2, n3;
    LWord r, s, tmpreg;
    a = floor(a);
    GenericRC = 0;
    if (-1073741824.0 < a && a < 1073741824.0) return famint_((int)a);
    if (a < 0.0) a = -a, neg = 1;
    a = frexp(a, &i);
    a = 65536.0*a;
    d0 = (int)a;
    a = a - (double)d0;
    a = 65536.0*a;
    d1 = (int)a;
    a = a - (double)d1;
    a = 65536.0*a;
    d2 = (int)a;
    a = a - (double)d2;
    a = 65536.0*a;
    d3 = (int)a;
    a = a - (double)d3;
    i -= 64;
    while ((d3 & 1) == 0)
    {   i++;
        d3 = (d3 >> 1) | ((d2 & 1) << 15);
        d2 = (d2 >> 1) | ((d1 & 1) << 15);
        d1 = (d1 >> 1) | ((d0 & 1) << 15);
        d0 = (d0 >> 1);
    }
    if (d0 == 0 && d1 == 0 && d2 < 0x4000)
        *--FAM_AP = famint_(d3 | (d2 << 16));
    else
    {   c =             d0; d0 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d1; d1 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d2; d2 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d3; d3 = c / 10000u; n0 = c % 10000u;
    
        c =             d0; d0 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d1; d1 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d2; d2 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d3; d3 = c / 10000u; n1 = c % 10000u;

        c =             d0; d0 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d1; d1 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d2; d2 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d3; d3 = c / 10000u; n2 = c % 10000u;

        c =             d0; d0 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d1; d1 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d2; d2 = c / 10000u; c = c % 10000u;
        c = (c << 16) | d3; d3 = c / 10000u; n3 = c % 10000u;

        *--FAM_AP = 0;
        if (n3 != 0)
        {   AllCons_(new_cons, famint_(n3), *FAM_AP);
            *FAM_AP = (LWord)new_cons;
        }
        if (*FAM_AP != 0 || n2 != 0)
        {   AllCons_(new_cons, famint_(n2), *FAM_AP);
            *FAM_AP = (LWord)new_cons;
        }
        if (*FAM_AP != 0 || n1 != 0)
        {   AllCons_(new_cons, famint_(n1), *FAM_AP);
            *FAM_AP = (LWord)new_cons;
        }
        AllCons_(new_cons, famint_(n0), *FAM_AP);
        *FAM_AP = (LWord)new_cons;
    }
    s = GenericTWO(i);
    r = *FAM_AP++;
    r = GenericTIMES(r, s);
    if (neg) r = GenericNEG(r);
    return r;
}

double GenericREAL(LWord a)
{
    GenericRC = 0;
    if (BigNum_(a))
    {   double r = 0.0;
        int sign = (cint_(hd_(a)) & 0x10000);
        LWord p;
        while (!Immed_(a))
        {   if (r >= DBL_MAX/10000.0)  /* I hope this avoids overflow */
            {   GenericRC = 1;
                return 0.0;
            }
            r = 10000.0 * r + (cint_(hd_(a)) & 0xffff);
            a = (LWord)tl_(a);
        }
        if (sign != 0) r = -r;
        return r;
    }
    return (double)(SLWord)cint_(a);
}

/* end of "bignum.c" */

