# Division ganzer Zahlen

# Dividiert zwei Unsigned Digit sequences durcheinander.
# UDS_divide(a_MSDptr,a_len,a_LSDptr, b_MSDptr,b_len,b_LSDptr, &q,&r);
# Die UDS a = a_MSDptr/a_len/a_LSDptr (a>=0) wird durch
# die UDS b = b_MSDptr/b_len/b_LSDptr (b>=0) dividiert:
# a = q * b + r mit 0 <= r < b. Bei b=0 Error.
# q der Quotient, r der Rest.
# q = q_MSDptr/q_len/q_LSDptr, r = r_MSDptr/r_len/r_LSDptr beides
# Normalized Unsigned Digit sequences.
# Vorsicht: q_LSDptr <= r_MSDptr,
#           Vorzeichenerweiterung von r kann q zerstören!
#           Vorzeichenerweiterung von q ist erlaubt.
# a und b werden nicht modifiziert.
# num_stack wird erniedrigt.
  #define UDS_divide(a_MSDptr,a_len,a_LSDptr,b_MSDptr,b_len,b_LSDptr,q_,r_)  \
    { # Platz fürs Ergebnis machen. Brauche maximal a_len+1 Digits.                \
      var uintC _a_len = (a_len);                                                  \
      var uintD* roomptr; num_stack_need_1(_a_len+1,roomptr=,);                    \
      UDS_divide_(a_MSDptr,_a_len,a_LSDptr,b_MSDptr,b_len,b_LSDptr,roomptr,q_,r_); \
    }
  local void UDS_divide_ (uintD* a_MSDptr, uintC a_len, uintD* a_LSDptr,
                          uintD* b_MSDptr, uintC b_len, uintD* b_LSDptr,
                          uintD* roomptr, DS* q_, DS* r_);
# Methode:
# erst a und b normalisieren: a=[a[m-1],...,a[0]], b=[b[n-1],...,b[0]]
# mit m>=0 und n>0 (Stellensystem der Basis beta=2^intDsize).
# Falls m<n, ist q:=0 und r:=a.
# Falls m>=n=1, Single-Precision-Division:
#   r:=0, j:=m,
#   while j>0 do
#     {Hier (q[m-1]*beta^(m-1)+...+q[j]*beta^j) * b[0] + r*beta^j =
#           = a[m-1]*beta^(m-1)+...+a[j]*beta^j und 0<=r<b[0]<beta}
#     j:=j-1, r:=r*beta+a[j], q[j]:=floor(r/b[0]), r:=r-b[0]*q[j].
#   Normalisiere [q[m-1],...,q[0]], liefert q.
# Falls m>=n>1, Multiple-Precision-Division:
#   Es gilt a/b < beta^(m-n+1).
#   s:=intDsize-1-(Nummer des höchsten Bits in b[n-1]), 0<=s<intDsize.
#   Schiebe a und b um s Bits nach links und kopiere sie dabei. r:=a.
#   r=[r[m],...,r[0]], b=[b[n-1],...,b[0]] mit b[n-1]>=beta/2.
#   Für j=m-n,...,0: {Hier 0 <= r < b*beta^(j+1).}
#     Berechne q* :
#       q* := floor((r[j+n]*beta+r[j+n-1])/b[n-1]).
#       Bei Überlauf (q* >= beta) setze q* := beta-1.
#       Berechne c2 := ((r[j+n]*beta+r[j+n-1]) - q* * b[n-1])*beta + r[j+n-2]
#       und c3 := b[n-2] * q*.
#       {Es ist 0 <= c2 < 2*beta^2, sogar 0 <= c2 < beta^2 falls kein
#        Überlauf aufgetreten war. Ferner 0 <= c3 < beta^2.
#        Bei Überlauf und r[j+n]*beta+r[j+n-1] - q* * b[n-1] >= beta,
#        das heißt c2 >= beta^2, kann man die nächste Abfrage überspringen.}
#       Solange c3 > c2, {hier 0 <= c2 < c3 < beta^2} setze
#         q* := q* - 1, c2 := c2 + b[n-1]*beta, c3 := c3 - b[n-2].
#       Falls q* > 0:
#         Setze r := r - b * q* * beta^j, im einzelnen:
#           [r[n+j],...,r[j]] := [r[n+j],...,r[j]] - q* * [b[n-1],...,b[0]].
#           also: u:=0, for i:=0 to n-1 do
#                         u := u + q* * b[i],
#                         r[j+i]:=r[j+i]-(u mod beta) (+ beta, falls Carry),
#                         u:=u div beta (+ 1, falls bei der Subtraktion Carry)
#                 r[n+j]:=r[n+j]-u.
#           {Da stets u = (q* * [b[i-1],...,b[0]] div beta^i) + 1
#                       < q* + 1 <= beta, läuft der Übertrag u nicht über.}
#         Tritt dabei ein negativer Übertrag auf, so setze q* := q* - 1
#           und [r[n+j],...,r[j]] := [r[n+j],...,r[j]] + [0,b[n-1],...,b[0]].
#     Setze q[j] := q*.
#   Normalisiere [q[m-n],..,q[0]] und erhalte den Quotienten q,
#   Schiebe [r[n-1],...,r[0]] um s Bits nach rechts, normalisiere und
#   erhalte den Rest r.
#   Dabei kann q[j] auf dem Platz von r[n+j] liegen.
  local void UDS_divide_(a_MSDptr,a_len,a_LSDptr, b_MSDptr,b_len,b_LSDptr,roomptr,q_,r_)
    var uintD* a_MSDptr;
    var uintC a_len;
    var uintD* a_LSDptr;
    var uintD* b_MSDptr;
    var uintC b_len;
    var uintD* b_LSDptr;
    var uintD* roomptr; # ab roomptr kommen a_len+1 freie Digits
    var DS* q_;
    var DS* r_;
    {
      # a normalisieren (a_MSDptr erhöhen, a_len erniedrigen):
      while ((a_len>0) && (a_MSDptr[0]==0)) {
        a_MSDptr++; a_len--;
      }
      # b normalisieren (b_MSDptr erhöhen, b_len erniedrigen):
      loop {
        if (b_len==0)
          divide_0();
        if (b_MSDptr[0]==0) {
          b_MSDptr++; b_len--;
        } else
          break;
      }
      # jetzt m=a_len >=0 und n=b_len >0.
      if (a_len < b_len) {
        # m<n: Trivialfall, q=0, r:= Kopie von a.
        var uintD* r_MSDptr = roomptr;
        var uintD* r_LSDptr = &roomptr[a_len];
        # Speicheraufbau: r_MSDptr/0/r_MSDptr/a_len/r_LSDptr
        #                    |     q    |       r      |
        copy_loop_down(a_LSDptr,r_LSDptr,a_len);
        q_->MSDptr = r_MSDptr; q_->len = 0; q_->LSDptr = r_MSDptr; # q = 0, eine NUDS
        r_->MSDptr = r_MSDptr; r_->len = a_len; r_->LSDptr = r_LSDptr; # r = Kopie von a, eine NUDS
        return;
      } elif (b_len==1) {
        # n=1: Single-Precision-Division
        # beta^(m-1) <= a < beta^m  ==>  beta^(m-2) <= a/b < beta^m
        var uintD* q_MSDptr = roomptr;
        var uintD* q_LSDptr = &roomptr[a_len];
        var uintD* r_MSDptr = q_LSDptr;
        var uintD* r_LSDptr = &r_MSDptr[1];
        # Speicheraufbau: q_MSDptr/a_len/q_LSDptr    r_MSDptr/1/r_LSDptr
        #                     |      q      |           |     r    |
        var uintD rest = divucopy_loop_up(b_MSDptr[0],a_MSDptr,q_MSDptr,a_len); # Division durch b[0]
        var uintC r_len;
        if (!(rest==0)) {
          r_MSDptr[0] = rest; r_len=1; # Rest als r ablegen
        } else {
          r_MSDptr = r_LSDptr; r_len=0; # Rest auf 0 normalisieren
        }
        if (q_MSDptr[0]==0) {
          q_MSDptr++; a_len--; # q normalisieren
        }
        q_->MSDptr = q_MSDptr; q_->len = a_len; q_->LSDptr = q_LSDptr; # q ablegen
        r_->MSDptr = r_MSDptr; r_->len = r_len; r_->LSDptr = r_LSDptr; # r ablegen
        return;
      } else {
        # n>1: Multiple-Precision-Division
        # beta^(m-1) <= a < beta^m, beta^(n-1) <= b < beta^n  ==>
        # beta^(m-n-1) <= a/b < beta^(m-n+1).
        var uintL s;
        SAVE_NUM_STACK # num_stack retten
        # s bestimmen:
        {
          var uintD msd = b_MSDptr[0]; # b[n-1]
          #if 0
          s = 0;
          while ((sintD)msd >= 0) {
            msd = msd<<1; s++;
          }
          #else # ein wenig effizienter, Abfrage auf s=0 vorwegnehmen
          if ((sintD)msd < 0) {
            s = 0; goto shift_ok;
          } else {
            integerlengthD(msd, s = intDsize - ); goto shift;
          }
          #endif
        }
        # 0 <= s < intDsize.
        # Kopiere b und schiebe es dabei um s Bits nach links:
        if (!(s==0))
         shift:
          {
            var uintD* old_b_LSDptr = b_LSDptr;
            num_stack_need(b_len,b_MSDptr=,b_LSDptr=);
            shiftleftcopy_loop_down(old_b_LSDptr,b_LSDptr,b_len,s);
          }
       shift_ok:
        # Wieder b = b_MSDptr/b_len/b_LSDptr.
        # Kopiere a und schiebe es dabei um s Bits nach links, erhalte r:
        var uintD* r_MSDptr = roomptr;
        var uintD* r_LSDptr = &roomptr[a_len+1];
        # Speicheraufbau:  r_MSDptr/          a_len+1           /r_LSDptr
        #                     |                  r                  |
        # später:          q_MSDptr/a_len-b_len+1/r_MSDptr/b_len/r_LSDptr
        #                     |           q          |       r      |
        if (s==0) {
          copy_loop_down(a_LSDptr,r_LSDptr,a_len); r_MSDptr[0] = 0;
        } else {
          r_MSDptr[0] = shiftleftcopy_loop_down(a_LSDptr,r_LSDptr,a_len,s);
        }
        # Nun r = r_MSDptr/a_len+1/r_LSDptr.
        var uintC j = a_len-b_len; # m-n
        var uintD* r_ptr = &r_LSDptr[-(uintP)j]; # Pointer oberhalb von r[j]
        var uintD* q_MSDptr = r_MSDptr;
        var uintC q_len = j = j+1; # q wird m-n+1 Digits haben
        var uintD b_msd = b_MSDptr[0]; # b[n-1]
        var uintD b_2msd = b_MSDptr[1]; # b[n-2]
        #if HAVE_DD
        var uintDD b_msdd = highlowDD(b_msd,b_2msd); # b[n-1]*beta+b[n-2]
        #endif
        # Divisions-Schleife: (wird m-n+1 mal durchlaufen)
        # j = Herabzähler, b_MSDptr/b_len/b_LSDptr = [b[n-1],...,b[0]], b_len=n,
        # r_MSDptr = Pointer auf r[n+j] = Pointer auf q[j],
        # r_ptr = Pointer oberhalb von r[j].
        do {
          var uintD q_stern;
          var uintD c1;
          if (r_MSDptr[0] < b_msd) { # r[j+n] < b[n-1] ?
            # Dividiere r[j+n]*beta+r[j+n-1] durch b[n-1], ohne Überlauf:
            #if HAVE_DD
              divuD(highlowDD(r_MSDptr[0],r_MSDptr[1]),b_msd, q_stern=,c1=);
            #else
              divuD(r_MSDptr[0],r_MSDptr[1],b_msd, q_stern=,c1=);
            #endif
          } else {
            # Überlauf, also r[j+n]*beta+r[j+n-1] >= beta*b[n-1]
            q_stern = bitm(intDsize)-1; # q* = beta-1
            # Teste ob r[j+n]*beta+r[j+n-1] - (beta-1)*b[n-1] >= beta
            # <==> r[j+n]*beta+r[j+n-1] + b[n-1] >= beta*b[n-1]+beta
            # <==> b[n-1] < floor((r[j+n]*beta+r[j+n-1]+b[n-1])/beta) {<= beta !} ist.
            # Wenn ja, direkt zur Subtraktionschleife.
            # (Andernfalls ist r[j+n]*beta+r[j+n-1] - (beta-1)*b[n-1] < beta
            #  <==> floor((r[j+n]*beta+r[j+n-1]+b[n-1])/beta) = b[n-1] ).
            if ((r_MSDptr[0] > b_msd) || ((c1 = r_MSDptr[1]+b_msd) < b_msd)) {
              # r[j+n] >= b[n-1]+1 oder
              # r[j+n] = b[n-1] und Addition r[j+n-1]+b[n-1] gibt Carry ?
              goto subtract; # ja -> direkt in die Subtraktion
            }
          }
          # q_stern = q*,
          # c1 = (r[j+n]*beta+r[j+n-1]) - q* * b[n-1] (>=0, <beta).
          #if HAVE_DD
            {
              var uintDD c2 = highlowDD(c1,r_MSDptr[2]); # c1*beta+r[j+n-2]
              var uintDD c3 = muluD(b_2msd,q_stern); # b[n-2] * q*
              # Solange c2 < c3, c2 erhöhen, c3 erniedrigen:
              # Rechne dabei mit c3-c2:
              # solange >0, um b[n-1]*beta+b[n-2] erniedrigen.
              # Dies kann wegen b[n-1]*beta+b[n-2] >= beta^2/2
              # höchstens zwei mal auftreten.
              if (c3 > c2) {
                q_stern = q_stern-1; # q* := q* - 1
                if (c3-c2 > b_msdd)
                  q_stern = q_stern-1; # q* := q* - 1
              }
            }
          #else
            # Wie oben, nur mit zweigeteilten c2=[c2hi|c2lo] und c3=[c3hi|c3lo]:
            #define c2hi c1
            {
              var uintD c2lo = r_MSDptr[2]; # c2hi*beta+c2lo = c1*beta+r[j+n-2]
              var uintD c3hi;
              var uintD c3lo;
              muluD(b_2msd,q_stern, c3hi=,c3lo=); # c3hi*beta+c3lo = b[n-2] * q*
              if ((c3hi > c2hi) || ((c3hi == c2hi) && (c3lo > c2lo))) {
                q_stern = q_stern-1; # q* := q* - 1
                c3hi -= c2hi; if (c3lo < c2lo) c3hi--; c3lo -= c2lo; # c3 := c3-c2
                if ((c3hi > b_msd) || ((c3hi == b_msd) && (c3lo > b_2msd)))
                  q_stern = q_stern-1; # q* := q* - 1
              }
            }
            #undef c2hi
          #endif
          if (!(q_stern==0))
           subtract:
            {
              # Subtraktionsschleife: r := r - b * q* * beta^j
              var uintD carry = mulusub_loop_down(q_stern,b_LSDptr,r_ptr,b_len);
              # Noch r_ptr[-b_len-1] -= carry, d.h. r_MSDptr[0] -= carry
              # durchführen und danach r_MSDptr[0] vergessen:
              if (carry > r_MSDptr[0]) {
                # Subtraktion ergab Übertrag
                q_stern = q_stern-1; # q* := q* - 1
                addto_loop_down(b_LSDptr,r_ptr,b_len); # Additionsschleife
                # r[n+j] samt Carry kann vergessen werden...
              }
            }
          # Berechnung von q* ist fertig.
          *r_MSDptr++ = q_stern; # als q[j] ablegen
          r_ptr++;
        } until (--j == 0);
        # Nun ist q = [q[m-n],..,q[0]] = q_MSDptr/q_len/r_MSDptr
        # und r = [r[n-1],...,r[0]] = r_MSDptr/b_len/r_LSDptr.
        # q normalisieren und ablegen:
        if (q_MSDptr[0]==0) {
          q_MSDptr++; q_len--;
        }
        q_->MSDptr = q_MSDptr; q_->len = q_len; q_->LSDptr = r_MSDptr;
        # Schiebe [r[n-1],...,r[0]] um s Bits nach rechts:
        if (!(s==0)) {
          shiftright_loop_up(r_MSDptr,b_len,s);
        }
        # r normalisieren und ablegen:
        while ((b_len>0) && (r_MSDptr[0]==0)) {
          r_MSDptr++; b_len--;
        }
        r_->MSDptr = r_MSDptr; r_->len = b_len; r_->LSDptr = r_LSDptr;
        RESTORE_NUM_STACK # num_stack zurück
        return;
      }
    }

# Dividiert zwei Integers x,y >=0 und liefert Quotient und Rest
# der Division x/y. Bei y=0 Error.
# I_I_divide_I_I(x,y);
# > x,y: Integers >=0
# < STACK_1: Quotient q
# < STACK_0: Rest r
# Erniedrigt STACK um 2
# can trigger GC
  local void I_I_divide_I_I (object x, object y);
  local void I_I_divide_I_I(x,y)
    var object x;
    var object y;
    {
      if (I_fixnump(x)) {
        # x Fixnum >=0
        if (I_fixnump(y)) {
          # auch y Fixnum >=0
          var uint32 x_ = posfixnum_to_L(x);
          var uint32 y_ = posfixnum_to_L(y);
          if (y_==0) {
            divide_0();
          } elif (x_ < y_) {
            # Trivialfall: q=0, r=x
            goto trivial;
          } elif (y_ < bit(16)) {
            # 32-durch-16-Bit-Division
            var uint32 q;
            var uint16 r;
            divu_3216_3216(x_,y_,q=,r=);
            pushSTACK(UL_to_I(q));
            pushSTACK(fixnum((uintL)r));
          } else {
            # volle 32-durch-32-Bit-Division
            var uint32 q;
            var uint32 r;
            divu_3232_3232(x_,y_,q=,r=);
            pushSTACK(UL_to_I(q));
            pushSTACK(UL_to_I(r));
          }
        } else {
          # y Bignum >0
         trivial:
          # Trivialfall: q=0, r=x
          pushSTACK(Fixnum_0);
          pushSTACK(x);
        }
      } else {
        # x Bignum -> allgemeine Division:
        var uintD* x_MSDptr;
        var uintC x_len;
        var uintD* x_LSDptr;
        var uintD* y_MSDptr;
        var uintC y_len;
        var uintD* y_LSDptr;
        # x in NDS umwandeln, als UDS auffassen:
        BN_to_NDS_nocopy(x, x_MSDptr=,x_len=,x_LSDptr=);
        {
          # y in NDS umwandeln, als UDS auffassen:
          I_to_NDS_nocopy(y, y_MSDptr=,y_len=,y_LSDptr=);
          # dividieren:
          {
            SAVE_NUM_STACK # num_stack retten
            var DS q;
            var DS r;
            begin_arith_call();
            UDS_divide(x_MSDptr,x_len,x_LSDptr,y_MSDptr,y_len,y_LSDptr, &q,&r);
            end_arith_call();
            # q in Integer umwandeln:
            pushSTACK(NUDS_to_I(q.MSDptr,q.len));
            # r in Integer umwandeln (jetzt erst, nachdem q verwertet ist!):
            pushSTACK(NUDS_to_I(r.MSDptr,r.len));
            RESTORE_NUM_STACK # num_stack zurück
          }
        }
      }
    }

# Fehler, wenn Quotient keine ganze Zahl ist
# > STACK_1: Zähler x
# > STACK_0: Nenner y
  nonreturning_function(local, fehler_exquo, (void)) {
    pushSTACK(S(exquo)); # Wert für Slot OPERATION von ARITHMETIC-ERROR
    pushSTACK(STACK_(1+1)); pushSTACK(STACK_(0+2));
    { var object tmp = listof(2); pushSTACK(tmp); } # Wert für Slot OPERANDS von ARITHMETIC-ERROR
    pushSTACK(STACK_(1+2)); # x
    pushSTACK(STACK_(0+3)); # y
    fehler(arithmetic_error,
           GETTEXT("quotient ~ / ~ is not an integer")
          );
  }

# Dividiert zwei Integers x,y >=0 und liefert den Quotienten x/y >=0.
# Bei y=0 Error. Die Division muss aufgehen, sonst Error.
# I_I_exquopos_I(x,y)
# > x,y: Integers >=0
# < ergebnis: Quotient x/y, ein Integer >=0
# can trigger GC
  local object I_I_exquopos_I (object x, object y);
# Methode:
# (exquopos x y) :==
# (DIVIDE x y) -> q,r
# Falls r<>0, Error.
# Liefere q.
  local object I_I_exquopos_I(x,y)
    var object x;
    var object y;
    {
      pushSTACK(y);
      pushSTACK(x);
      # Stackaufbau: y, x.
      I_I_divide_I_I(x,y); # q,r auf den Stack
      # Stackaufbau: y, x, q, r.
      if (!eq(STACK_0,Fixnum_0)) {
        skipSTACK(2); fehler_exquo();
      }
      var object q = STACK_1;
      skipSTACK(4); return q;
    }

# Dividiert zwei Integers x,y und liefert den Quotienten x/y.
# Bei y=0 Error. Die Division muss aufgehen, sonst Error.
# I_I_exquo_I(x,y)
# > x,y: Integers
# < ergebnis: Quotient x/y, ein Integer
# can trigger GC
  local object I_I_exquo_I (object x, object y);
# Methode:
# (exquo x y) :==
# (DIVIDE (abs x) (abs y)) -> q,r
# Falls r<>0, Error.
# Falls x,y verschiedene Vorzeichen haben, liefere -q, sonst q.
  local object I_I_exquo_I(x,y)
    var object x;
    var object y;
    {
      pushSTACK(y);
      pushSTACK(x);
      pushSTACK(I_abs_I(y));
      # Stackaufbau: y, x, (abs y).
      x = I_abs_I(STACK_1); # (abs x)
      I_I_divide_I_I(x,STACK_0); # q,r auf den Stack
      # Stackaufbau: y, x, (abs y), q, r.
      if (!eq(STACK_0,Fixnum_0)) {
        skipSTACK(3); fehler_exquo();
      }
      var object q = STACK_1;
      if (!same_sign_p(STACK_3,STACK_4)) {
        # x,y haben verschiedene Vorzeichen
        skipSTACK(5); return I_minus_I(q);
      } else {
        # x,y haben gleiche Vorzeichen
        skipSTACK(5); return q;
      }
    }

# I_I_mod_I(x,y) = (mod x y), wo x,y Integers sind.
# can trigger GC
  local object I_I_mod_I (object x, object y);
# Methode:
# (mod x y) :==
# (DIVIDE (abs x) (abs y)) -> q,r
# Falls r=0, liefere 0.
# Falls x,y verschiedene Vorzeichen haben, setze r:=r-abs(y).
# Falls x<0, setze r:=-r.
# Liefere r.
  local object I_I_mod_I(x,y)
    var object x;
    var object y;
    {
      pushSTACK(y);
      pushSTACK(x);
      pushSTACK(I_abs_I(y));
      # Stackaufbau: y, x, (abs y).
      x = I_abs_I(STACK_1); # (abs x)
      I_I_divide_I_I(x,STACK_0); # q,r auf den Stack
      # Stackaufbau: y, x, (abs y), q, r.
      var object r = STACK_0;
      if (!eq(r,Fixnum_0)) {
        if (!same_sign_p(STACK_3,STACK_4)) {
          # x,y haben verschiedene Vorzeichen
          r = I_I_minus_I(r,STACK_2); # r := (- r (abs y))
        }
        if (R_minusp(STACK_3))
          r = I_minus_I(r); # x<0 -> r := (- r)
      }
      skipSTACK(5); return r;
    }

# I_I_rem_I(x,y) = (rem x y), wo x,y Integers sind.
# can trigger GC
  local object I_I_rem_I (object x, object y);
# Methode:
# (rem x y) :==
# (DIVIDE (abs x) (abs y)) -> q,r
# Falls x<0, setze r:=-r.
# Liefere r.
  local object I_I_rem_I(x,y)
    var object x;
    var object y;
    {
      pushSTACK(y);
      pushSTACK(x);
      pushSTACK(I_abs_I(y));
      # Stackaufbau: y, x, (abs y).
      x = I_abs_I(STACK_1); # (abs x)
      I_I_divide_I_I(x,STACK_0); # q,r auf den Stack
      # Stackaufbau: y, x, (abs y), q, r.
      var object r = STACK_0;
      if (!eq(r,Fixnum_0)) {
        if (R_minusp(STACK_3))
          r = I_minus_I(r); # x<0 -> r := (- r)
      }
      skipSTACK(5); return r;
    }

# Dividiert zwei Integers x,y und liefert Quotient und Rest
# (q,r) := (floor x y)
# I_I_floor_I_I(x,y);
# > x,y: Integers
# < STACK_1: Quotient q
# < STACK_0: Rest r
# Erniedrigt STACK um 2
# can trigger GC
  local void I_I_floor_I_I (object x, object y);
# Methode:
# (floor x y) :==
# (DIVIDE (abs x) (abs y)) -> q,r
# Falls x,y verschiedene Vorzeichen haben und r<>0,
#   setze q:=q+1 und r:=r-abs(y).
# Falls x<0, setze r:=-r.
# Falls x,y verschiedene Vorzeichen haben, setze q:=-q.
# Liefere q,r.
  local void I_I_floor_I_I(x,y)
    var object x;
    var object y;
    {
      pushSTACK(y);
      pushSTACK(x);
      pushSTACK(I_abs_I(y));
      # Stackaufbau: y, x, (abs y).
      x = I_abs_I(STACK_1); # (abs x)
      I_I_divide_I_I(x,STACK_0); # q,r auf den Stack
      # Stackaufbau: y, x, (abs y), q, r.
      if (!same_sign_p(STACK_3,STACK_4))
        # x,y haben verschiedene Vorzeichen
        if (!eq(STACK_0,Fixnum_0)) {
          # r/=0, also r>0.
          STACK_1 = I_1_plus_I(STACK_1); # q := (1+ q)
          STACK_0 = I_I_minus_I(STACK_0,STACK_2); # r := (- r (abs y))
        }
      if (R_minusp(STACK_3)) {
        # x<0
        STACK_0 = I_minus_I(STACK_0); # r := (- r)
        if (!R_minusp(STACK_4)) # y>=0 ?
          goto negate_q; # q := (- q)
      } else {
        # x>=0
        if (R_minusp(STACK_4)) # y<0 ?
          negate_q: { STACK_1 = I_minus_I(STACK_1); } # q := (- q)
      }
      STACK_4 = STACK_1; STACK_3 = STACK_0; skipSTACK(3); # Stack aufräumen
    }

# Dividiert zwei Integers x,y und liefert Quotient und Rest
# (q,r) := (ceiling x y)
# I_I_ceiling_I_I(x,y);
# > x,y: Integers
# < STACK_1: Quotient q
# < STACK_0: Rest r
# Erniedrigt STACK um 2
# can trigger GC
  local void I_I_ceiling_I_I (object x, object y);
# Methode:
# (ceiling x y) :==
# (DIVIDE (abs x) (abs y)) -> q,r
# Falls x,y selbes Vorzeichen haben und r<>0,
#   setze q:=q+1 und r:=r-abs(y).
# Falls x<0, setze r:=-r.
# Falls x,y verschiedene Vorzeichen haben, setze q:=-q.
# Liefere q,r.
  local void I_I_ceiling_I_I(x,y)
    var object x;
    var object y;
    {
      pushSTACK(y);
      pushSTACK(x);
      pushSTACK(I_abs_I(y));
      # Stackaufbau: y, x, (abs y).
      x = I_abs_I(STACK_1); # (abs x)
      I_I_divide_I_I(x,STACK_0); # q,r auf den Stack
      # Stackaufbau: y, x, (abs y), q, r.
      if (same_sign_p(STACK_3,STACK_4))
        # x,y haben selbes Vorzeichen
        if (!eq(STACK_0,Fixnum_0)) {
          # r/=0, also r>0.
          STACK_1 = I_1_plus_I(STACK_1); # q := (1+ q)
          STACK_0 = I_I_minus_I(STACK_0,STACK_2); # r := (- r (abs y))
        }
      if (R_minusp(STACK_3)) {
        # x<0
        STACK_0 = I_minus_I(STACK_0); # r := (- r)
        if (!R_minusp(STACK_4)) # y>=0 ?
          goto negate_q; # q := (- q)
      } else {
        # x>=0
        if (R_minusp(STACK_4)) # y<0 ?
          negate_q: { STACK_1 = I_minus_I(STACK_1); } # q := (- q)
      }
      STACK_4 = STACK_1; STACK_3 = STACK_0; skipSTACK(3); # Stack aufräumen
    }

# Dividiert zwei Integers x,y und liefert Quotient und Rest
# (q,r) := (truncate x y)
# I_I_truncate_I_I(x,y);
# > x,y: Integers
# < STACK_1: Quotient q
# < STACK_0: Rest r
# Erniedrigt STACK um 2
# can trigger GC
  local void I_I_truncate_I_I (object x, object y);
# Methode:
# (truncate x y) :==
# (DIVIDE (abs x) (abs y)) -> q,r
# Falls x<0, setze r:=-r.
# Falls x,y verschiedene Vorzeichen haben, setze q:=-q.
# Liefere q,r.
  local void I_I_truncate_I_I(x,y)
    var object x;
    var object y;
    {
      pushSTACK(y);
      pushSTACK(x);
      pushSTACK(I_abs_I(y));
      # Stackaufbau: y, x, (abs y).
      x = I_abs_I(STACK_1); # (abs x)
      I_I_divide_I_I(x,popSTACK()); # q,r auf den Stack
      # Stackaufbau: y, x, q, r.
      if (R_minusp(STACK_2)) {
        # x<0
        STACK_0 = I_minus_I(STACK_0); # r := (- r)
        if (!R_minusp(STACK_3)) # y>=0 ?
          goto negate_q; # q := (- q)
      } else {
        # x>=0
        if (R_minusp(STACK_3)) # y<0 ?
          negate_q: { STACK_1 = I_minus_I(STACK_1); } # q := (- q)
      }
      STACK_3 = STACK_1; STACK_2 = STACK_0; skipSTACK(2); # Stack aufräumen
    }

# Dividiert zwei Integers x,y und liefert Quotient und Rest
# (q,r) := (round x y)
# I_I_round_I_I(x,y);
# > x,y: Integers
# < STACK_1: Quotient q
# < STACK_0: Rest r
# Erniedrigt STACK um 2
# can trigger GC
  local void I_I_round_I_I (object x, object y);
# Methode:
# (round x y) :==
# (DIVIDE (abs x) (abs y)) -> q,r
# Setze s:=abs(y)-r.
# Falls (r>s) oder (r=s und q ungerade),
#   (d.h. falls r>abs(y)/2 oder r=abs(y)/2 und q ungerade),
#   setze q:=q+1 und r:=-s (d.h. r:=r-abs(y)).
# {Nun ist abs(r) <= abs(y)/2, bei abs(r)=abs(y)/2 ist q gerade.}
# Falls x<0, setze r:=-r.
# Falls x,y verschiedene Vorzeichen haben, setze q:=-q.
# Liefere q,r.
  local void I_I_round_I_I(x,y)
    var object x;
    var object y;
    {
      pushSTACK(y);
      pushSTACK(x);
      pushSTACK(I_abs_I(y));
      # Stackaufbau: y, x, (abs y).
      x = I_abs_I(STACK_1); # (abs x)
      I_I_divide_I_I(x,STACK_0); # q,r auf den Stack
      # Stackaufbau: y, x, (abs y), q, r.
      var object s = I_I_minus_I(STACK_2,STACK_0); # (- (abs y) r)
      var signean comp_r_s = I_I_comp(STACK_0,s); # vergleiche r und s
      if ((comp_r_s>0) || ((comp_r_s==0) && (I_oddp(STACK_1)))) { # (r>s) oder (r=s und q ungerade) ?
        STACK_0 = I_minus_I(s); # r := (- s) = (- r (abs y))
        STACK_1 = I_1_plus_I(STACK_1); # q := (1+ q)
      }
      if (R_minusp(STACK_3)) {
        # x<0
        STACK_0 = I_minus_I(STACK_0); # r := (- r)
        if (!R_minusp(STACK_4)) # y>=0 ?
          goto negate_q; # q := (- q)
      } else {
        # x>=0
        if (R_minusp(STACK_4)) # y<0 ?
          negate_q: { STACK_1 = I_minus_I(STACK_1); } # q := (- q)
      }
      STACK_4 = STACK_1; STACK_3 = STACK_0; skipSTACK(3); # Stack aufräumen
    }

