home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / intelem.d < prev    next >
Encoding:
Text File  |  1996-07-21  |  76.3 KB  |  1,775 lines
  1. # Elementare Grundfunktionen beim Arbeiten mit Integers
  2.  
  3. # Umwandlungsroutinen Digit-Sequence-Teil <--> Longword:
  4.  
  5. # get_32_Dptr(ptr)
  6. #   holt die nächsten 32 Bits aus den 32/intDsize Digits ab ptr.
  7. # set_32_Dptr(ptr,wert);
  8. #   speichert den Wert wert (32 Bits) in die 32/intDsize Digits ab ptr.
  9. # get_max32_Dptr(count,ptr)
  10. #   holt die nächsten count Bits aus den ceiling(count/intDsize) Digits ab ptr.
  11. # set_max32_Dptr(count,ptr,wert)
  12. #   speichert wert (count Bits) in die ceiling(count/intDsize) Digits ab ptr.
  13. # Jeweils ptr eine Variable vom Typ uintD*,
  14. #         wert eine Variable vom Typ uint32,
  15. #         count eine Variable oder constant-expression mit Wert >=0, <=32.
  16.   #if (intDsize==32)
  17.     #define get_32_Dptr(ptr)  ((uint32)((ptr)[0]))
  18.     #define set_32_Dptr(ptr,wert)  ((ptr)[0] = (uintD)(wert))
  19.     #define get_max32_Dptr(count,ptr)  \
  20.       ((count)==0 ? 0 :                \
  21.                     (uint32)((ptr)[0]) \
  22.       )
  23.     #define set_max32_Dptr(count,ptr,wert)  \
  24.       ((count)==0 ? 0 :                        \
  25.                     ((ptr)[0] = (uintD)(wert)) \
  26.       )
  27.   #endif
  28.   #if (intDsize==16)
  29.     # define get_32_Dptr(ptr)  (((uint32)((ptr)[0])<<16) | ((uint32)((ptr)[1])))
  30.     #define get_32_Dptr(ptr)  highlow32_at(ptr)
  31.     # define set_32_Dptr(ptr,wert)  ((ptr)[0] = (uintD)((wert)>>16), (ptr)[1] = (uintD)(wert))
  32.     #define set_32_Dptr(ptr,wert)  set_highlow32_at(ptr,wert)
  33.     #define get_max32_Dptr(count,ptr)  \
  34.       ((count)==0 ? 0 :                   \
  35.        (count)<=16 ? (uint32)((ptr)[0]) : \
  36.                      highlow32_at(ptr)    \
  37.       )
  38.     #define set_max32_Dptr(count,ptr,wert)  \
  39.       ((count)==0 ? 0 :                           \
  40.        (count)<=16 ? ((ptr)[0] = (uintD)(wert)) : \
  41.                      set_highlow32_at(ptr,wert)   \
  42.       )
  43.   #endif
  44.   #if (intDsize==8)
  45.     #define get_32_Dptr(ptr)  (((((( (uint32)((ptr)[0]) <<8) | (uint32)((ptr)[1])) <<8) | (uint32)((ptr)[2])) <<8) | (uint32)((ptr)[3]))
  46.     #define set_32_Dptr(ptr,wert)  ((ptr)[0] = (uintD)((wert)>>24), (ptr)[1] = (uintD)((wert)>>16), (ptr)[2] = (uintD)((wert)>>8), (ptr)[3] = (uintD)(wert))
  47.     #define get_max32_Dptr(count,ptr)  \
  48.       ((count)==0 ? 0 : \
  49.        (count)<=8 ? (uint32)((ptr)[0]) : \
  50.        (count)<=16 ? (( (uint32)((ptr)[0]) <<8) | (uint32)((ptr)[1])) : \
  51.        (count)<=24 ? (((( (uint32)((ptr)[0]) <<8) | (uint32)((ptr)[1])) <<8) | (uint32)((ptr)[2])) : \
  52.                      (((((( (uint32)((ptr)[0]) <<8) | (uint32)((ptr)[1])) <<8) | (uint32)((ptr)[2])) <<8) | (uint32)((ptr)[3])) \
  53.       )
  54.     #define set_max32_Dptr(count,ptr,wert)  \
  55.       ((count)==0 ? 0 : \
  56.        (count)<=8 ? ((ptr)[0] = (uintD)(wert)) : \
  57.        (count)<=16 ? ((ptr)[0] = (uintD)((wert)>>8), (ptr)[1] = (uintD)(wert)) : \
  58.        (count)<=24 ? ((ptr)[0] = (uintD)((wert)>>16), (ptr)[1] = (uintD)((wert)>>8), (ptr)[2] = (uintD)(wert)) : \
  59.                      ((ptr)[0] = (uintD)((wert)>>24), (ptr)[1] = (uintD)((wert)>>16), (ptr)[2] = (uintD)((wert)>>8), (ptr)[3] = (uintD)(wert)) \
  60.       )
  61.   #endif
  62.  
  63. # get_uint1D_Dptr(ptr)  holt 1 Digit (unsigned) ab ptr
  64. # get_uint2D_Dptr(ptr)  holt 2 Digits (unsigned) ab ptr
  65. # get_uint3D_Dptr(ptr)  holt 3 Digits (unsigned) ab ptr
  66. # get_uint4D_Dptr(ptr)  holt 4 Digits (unsigned) ab ptr
  67. # get_sint1D_Dptr(ptr)  holt 1 Digit (signed) ab ptr
  68. # get_sint2D_Dptr(ptr)  holt 2 Digits (signed) ab ptr
  69. # get_sint3D_Dptr(ptr)  holt 3 Digits (signed) ab ptr
  70. # get_sint4D_Dptr(ptr)  holt 4 Digits (signed) ab ptr
  71. # Jeweils ptr eine Variable vom Typ uintD*.
  72.   #define get_uint1D_Dptr(ptr)  ((uint32)((ptr)[0]))
  73.   #define get_uint2D_Dptr(ptr)  (((uint32)((ptr)[0]) << intDsize) | (uint32)((ptr)[1]))
  74.   #define get_uint3D_Dptr(ptr)  (((((uint32)((ptr)[0]) << intDsize) | (uint32)((ptr)[1])) << intDsize) | (uint32)((ptr)[2]))
  75.   #define get_uint4D_Dptr(ptr)  (((((((uint32)((ptr)[0]) << intDsize) | (uint32)((ptr)[1])) << intDsize) | (uint32)((ptr)[2])) << intDsize) | (uint32)((ptr)[3]))
  76.   #define get_sint1D_Dptr(ptr)  ((sint32)(sintD)((ptr)[0]))
  77.   #define get_sint2D_Dptr(ptr)  (((sint32)(sintD)((ptr)[0]) << intDsize) | (uint32)((ptr)[1]))
  78.   #define get_sint3D_Dptr(ptr)  (((((sint32)(sintD)((ptr)[0]) << intDsize) | (uint32)((ptr)[1])) << intDsize) | (uint32)((ptr)[2]))
  79.   #define get_sint4D_Dptr(ptr)  (((((((sint32)(sintD)((ptr)[0]) << intDsize) | (uint32)((ptr)[1])) << intDsize) | (uint32)((ptr)[2])) << intDsize) | (uint32)((ptr)[3]))
  80.   #if (intDsize==16) && (defined(MC680X0) && !defined(MC680Y0)) # Verbesserung:
  81.     #undef get_uint2D_Dptr
  82.     #undef get_sint2D_Dptr
  83.     #define get_uint2D_Dptr(ptr)  highlow32_at(ptr)
  84.     #define get_sint2D_Dptr(ptr)  (sint32)highlow32_at(ptr)
  85.   #endif
  86.   #if (intDsize==16)
  87.     #undef get_uint3D_Dptr
  88.     #undef get_uint4D_Dptr
  89.     #undef get_sint3D_Dptr
  90.     #undef get_sint4D_Dptr
  91.     #define get_uint3D_Dptr(ptr)  get_uint2D_Dptr(&(ptr)[1])
  92.     #define get_uint4D_Dptr(ptr)  get_uint2D_Dptr(&(ptr)[2])
  93.     #define get_sint3D_Dptr  get_uint3D_Dptr
  94.     #define get_sint4D_Dptr  get_uint4D_Dptr
  95.   #endif
  96.   #if (intDsize==32)
  97.     #undef get_uint2D_Dptr
  98.     #undef get_uint3D_Dptr
  99.     #undef get_uint4D_Dptr
  100.     #undef get_sint2D_Dptr
  101.     #undef get_sint3D_Dptr
  102.     #undef get_sint4D_Dptr
  103.     #define get_uint2D_Dptr(ptr)  get_uint1D_Dptr(&(ptr)[1])
  104.     #define get_uint3D_Dptr(ptr)  get_uint1D_Dptr(&(ptr)[2])
  105.     #define get_uint4D_Dptr(ptr)  get_uint1D_Dptr(&(ptr)[3])
  106.     #define get_sint2D_Dptr  get_uint2D_Dptr
  107.     #define get_sint3D_Dptr  get_uint3D_Dptr
  108.     #define get_sint4D_Dptr  get_uint4D_Dptr
  109.   #endif
  110.  
  111. # Umwandlungsroutinen Integer <--> Longword:
  112.  
  113. # Wandelt Fixnum in Longword um.
  114. # FN_to_L(obj)
  115. # > obj: ein Fixnum
  116. # < ergebnis: der Wert des Fixnum als 32-Bit-Zahl.
  117.   local sint32 FN_to_L (object obj);
  118.   #if 1
  119.     #define FN_to_L(obj)  fixnum_to_L(obj)
  120.   #else
  121.     local sint32 FN_to_L(obj)
  122.       var reg1 object obj;
  123.       { if (R_minusp(obj))
  124.           # negativ: mit 1-Bits füllen
  125.           return (as_oint(obj) >> oint_data_shift) | ~ (FN_value_mask >> oint_data_shift);
  126.           else
  127.           # >=0: mit 0-Bits füllen
  128.           return (as_oint(obj) >> oint_data_shift) & (FN_value_mask >> oint_data_shift);
  129.       }
  130.   #endif
  131.  
  132. # FN_L_zerop(x,x_) stellt fest, ob x = 0 ist.
  133. # Dabei ist x ein Fixnum und x_ = FN_to_L(x).
  134.   #if (oint_data_len<intLsize)
  135.     #define FN_L_zerop(x,x_)  (x_==0)
  136.   #else
  137.     #define FN_L_zerop(x,x_)  (eq(x,Fixnum_0))
  138.   #endif
  139.  
  140. # FN_L_minusp(x,x_) stellt fest, ob x < 0 ist.
  141. # Dabei ist x ein Fixnum und x_ = FN_to_L(x).
  142.   #if (oint_data_len<intLsize)
  143.     #define FN_L_minusp(x,x_)  (x_<0)
  144.   #else
  145.     #define FN_L_minusp(x,x_)  (R_minusp(x))
  146.   #endif
  147.  
  148. #ifdef intQsize
  149. # Wandelt Fixnum in Quadword um.
  150. # FN_to_Q(obj)
  151. # > obj: ein Fixnum
  152. # < ergebnis: der Wert des Fixnum als 64-Bit-Zahl.
  153.   local sint64 FN_to_Q (object obj);
  154.   #define FN_to_Q(obj)  fixnum_to_Q(obj)
  155. #endif
  156.  
  157. # Wandelt Integer >=0 in Unsigned Longword um.
  158. # I_to_UL(obj)
  159. # > obj: ein Objekt, sollte ein Integer >=0, <2^32 sein
  160. # < ergebnis: der Wert des Integer als 32-Bit-Zahl.
  161.   global uint32 I_to_UL (object obj);
  162.   global uint32 I_to_UL(obj)
  163.     var reg2 object obj;
  164.     { switch (typecode(obj))
  165.         { case_posfixnum: # Fixnum >=0
  166.             return posfixnum_to_L(obj);
  167.           case_posbignum: # Bignum >0
  168.             { var reg1 Bignum bn = TheBignum(obj);
  169.               var reg3 uintC len = bn->length;
  170.               #define IF_LENGTH(i)  \
  171.                 if (bn_minlength <= i) # genau i Digits überhaupt möglich?       \
  172.                   if (len == i) # genau i Digits?                                \
  173.                     # 2^((i-1)*intDsize-1) <= obj < 2^(i*intDsize-1)             \
  174.                     if ( (i*intDsize-1 > 32)                                     \
  175.                          && ( ((i-1)*intDsize-1 >= 32)                           \
  176.                               || (bn->data[0] >= (uintD)bitc(32-(i-1)*intDsize)) \
  177.                        )    )                                                    \
  178.                       goto bad;                                                  \
  179.                       else
  180.               IF_LENGTH(1)
  181.                 return get_uint1D_Dptr(bn->data);
  182.               IF_LENGTH(2)
  183.                 return get_uint2D_Dptr(bn->data);
  184.               IF_LENGTH(3)
  185.                 return get_uint3D_Dptr(bn->data);
  186.               IF_LENGTH(4)
  187.                 return get_uint4D_Dptr(bn->data);
  188.               IF_LENGTH(5)
  189.                 return get_uint4D_Dptr(&bn->data[1]);
  190.               #undef IF_LENGTH
  191.             }
  192.           default:
  193.           bad: # unpassendes Objekt
  194.             pushSTACK(obj); # Wert für Slot DATUM von TYPE-ERROR
  195.             pushSTACK(O(type_uint32)); # Wert für Slot EXPECTED-TYPE von TYPE-ERROR
  196.             pushSTACK(obj);
  197.             //: DEUTSCH "Das ist keine 32-Bit-Zahl: ~"
  198.             //: ENGLISH "not a 32-bit integer: ~"
  199.             //: FRANCAIS "Ceci n'est pas un nombre à 32 bits : ~"
  200.             fehler(type_error, GETTEXT("not a 32-bit integer: ~"));
  201.     }   }
  202.  
  203. # Wandelt Integer in Signed Longword um.
  204. # I_to_L(obj)
  205. # > obj: ein Objekt, sollte ein Integer >=-2^31, <2^31 sein
  206. # < ergebnis: der Wert des Integer als 32-Bit-Zahl.
  207.   global sint32 I_to_L (object obj);
  208.   global sint32 I_to_L(obj)
  209.     var reg2 object obj;
  210.     { switch (typecode(obj))
  211.         { case_posfixnum: # Fixnum >=0
  212.             { var reg1 sintL wert = posfixnum_to_L(obj);
  213.               if ((oint_data_len+1 > intLsize) && (wert < 0)) goto bad;
  214.               return wert;
  215.             }
  216.           case_posbignum: # Bignum >0
  217.             { var reg1 Bignum bn = TheBignum(obj);
  218.               var reg3 uintC len = bn->length;
  219.               #define IF_LENGTH(i)  \
  220.                 if (bn_minlength <= i) # genau i Digits überhaupt möglich?       \
  221.                   if (len == i) # genau i Digits?                                \
  222.                     # 2^((i-1)*intDsize-1) <= obj < 2^(i*intDsize-1)             \
  223.                     if ( (i*intDsize > 32)                                       \
  224.                          && ( ((i-1)*intDsize >= 32)                             \
  225.                               || (bn->data[0] >= (uintD)bitc(31-(i-1)*intDsize)) \
  226.                        )    )                                                    \
  227.                       goto bad;                                                  \
  228.                       else
  229.               IF_LENGTH(1)
  230.                 return get_uint1D_Dptr(bn->data);
  231.               IF_LENGTH(2)
  232.                 return get_uint2D_Dptr(bn->data);
  233.               IF_LENGTH(3)
  234.                 return get_uint3D_Dptr(bn->data);
  235.               IF_LENGTH(4)
  236.                 return get_uint4D_Dptr(bn->data);
  237.               #undef IF_LENGTH
  238.               goto bad;
  239.             }
  240.           case_negfixnum: # Fixnum <0
  241.             { var reg1 sintL wert = negfixnum_to_L(obj);
  242.               if ((oint_data_len+1 > intLsize) && (wert >= 0)) goto bad;
  243.               return wert;
  244.             }
  245.           case_negbignum: # Bignum <0
  246.             { var reg1 Bignum bn = TheBignum(obj);
  247.               var reg3 uintC len = bn->length;
  248.               #define IF_LENGTH(i)  \
  249.                 if (bn_minlength <= i) # genau i Digits überhaupt möglich?         \
  250.                   if (len == i) # genau i Digits?                                  \
  251.                     # - 2^(i*intDsize-1) <= obj < - 2^((i-1)*intDsize-1)           \
  252.                     if ( (i*intDsize > 32)                                         \
  253.                          && ( ((i-1)*intDsize >= 32)                               \
  254.                               || (bn->data[0] < (uintD)(-bitc(31-(i-1)*intDsize))) \
  255.                        )    )                                                      \
  256.                       goto bad;                                                    \
  257.                       else
  258.               IF_LENGTH(1)
  259.                 return get_sint1D_Dptr(bn->data);
  260.               IF_LENGTH(2)
  261.                 return get_sint2D_Dptr(bn->data);
  262.               IF_LENGTH(3)
  263.                 return get_sint3D_Dptr(bn->data);
  264.               IF_LENGTH(4)
  265.                 return get_sint4D_Dptr(bn->data);
  266.               #undef IF_LENGTH
  267.               goto bad;
  268.             }
  269.           default:
  270.           bad: # unpassendes Objekt
  271.             pushSTACK(obj); # Wert für Slot DATUM von TYPE-ERROR
  272.             pushSTACK(O(type_sint32)); # Wert für Slot EXPECTED-TYPE von TYPE-ERROR
  273.             pushSTACK(obj);
  274.             //: DEUTSCH "Das ist keine 32-Bit-Zahl: ~"
  275.             //: ENGLISH "not a 32-bit integer: ~"
  276.             //: FRANCAIS "Ceci n'est pas un nombre à 32 bits : ~"
  277.             fehler(type_error, GETTEXT("not a 32-bit integer: ~"));
  278.     }   }
  279.  
  280. #if (defined(HAVE_FFI) || defined(HAVE_AFFI)) && defined(HAVE_LONGLONG)
  281.  
  282. # Wandelt Integer >=0 in Unsigned Quadword um.
  283. # I_to_UQ(obj)
  284. # > obj: ein Objekt, sollte ein Integer >=0, <2^64 sein
  285. # < ergebnis: der Wert des Integer als 64-Bit-Zahl.
  286.   global uint64 I_to_UQ (object obj);
  287.   global uint64 I_to_UQ(obj)
  288.     var reg2 object obj;
  289.     { switch (typecode(obj))
  290.         { case_posfixnum: # Fixnum >=0
  291.             return (uint64)posfixnum_to_L(obj);
  292.           case_posbignum: # Bignum >0
  293.             { var reg1 Bignum bn = TheBignum(obj);
  294.               var reg3 uintC len = bn->length;
  295.               #define IF_LENGTH(i)  \
  296.                 if (bn_minlength <= i) # genau i Digits überhaupt möglich?       \
  297.                   if (len == i) # genau i Digits?                                \
  298.                     # 2^((i-1)*intDsize-1) <= obj < 2^(i*intDsize-1)             \
  299.                     if ( (i*intDsize-1 > 64)                                     \
  300.                          && ( ((i-1)*intDsize-1 >= 64)                           \
  301.                               || (bn->data[0] >= (uintD)bitc(64-(i-1)*intDsize)) \
  302.                        )    )                                                    \
  303.                       goto bad;                                                  \
  304.                       else
  305.               #if (intDsize==32)
  306.               IF_LENGTH(1)
  307.                 return (uint64)get_uint1D_Dptr(bn->data);
  308.               IF_LENGTH(2)
  309.                 return ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint1D_Dptr(&bn->data[1]);
  310.               IF_LENGTH(3)
  311.                 return ((uint64)get_uint1D_Dptr(&bn->data[1]) << 32) | (uint64)get_uint1D_Dptr(&bn->data[2]);
  312.               #endif
  313.               #if (intDsize==16)
  314.               IF_LENGTH(1)
  315.                 return (uint64)get_uint1D_Dptr(bn->data);
  316.               IF_LENGTH(2)
  317.                 return (uint64)get_uint2D_Dptr(bn->data);
  318.               IF_LENGTH(3)
  319.                 return ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[1]);
  320.               IF_LENGTH(4)
  321.                 return ((uint64)get_uint2D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[2]);
  322.               IF_LENGTH(5)
  323.                 return ((uint64)get_uint2D_Dptr(&bn->data[1]) << 32) | (uint64)get_uint2D_Dptr(&bn->data[3]);
  324.               #endif
  325.               #if (intDsize==8)
  326.               IF_LENGTH(1)
  327.                 return (uint64)get_uint1D_Dptr(bn->data);
  328.               IF_LENGTH(2)
  329.                 return (uint64)get_uint2D_Dptr(bn->data);
  330.               IF_LENGTH(3)
  331.                 return (uint64)get_uint3D_Dptr(bn->data);
  332.               IF_LENGTH(4)
  333.                 return (uint64)get_uint4D_Dptr(bn->data);
  334.               IF_LENGTH(5)
  335.                 return ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[1]);
  336.               IF_LENGTH(6)
  337.                 return ((uint64)get_uint2D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[2]);
  338.               IF_LENGTH(7)
  339.                 return ((uint64)get_uint3D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[3]);
  340.               IF_LENGTH(8)
  341.                 return ((uint64)get_uint4D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[4]);
  342.               IF_LENGTH(9)
  343.                 return ((uint64)get_uint4D_Dptr(&bn->data[1]) << 32) | (uint64)get_uint4D_Dptr(&bn->data[5]);
  344.               #endif
  345.               #undef IF_LENGTH
  346.             }
  347.           default:
  348.           bad: # unpassendes Objekt
  349.             pushSTACK(obj); # Wert für Slot DATUM von TYPE-ERROR
  350.             pushSTACK(O(type_uint64)); # Wert für Slot EXPECTED-TYPE von TYPE-ERROR
  351.             pushSTACK(obj);
  352.             //: DEUTSCH "Das ist keine 64-Bit-Zahl: ~"
  353.             //: ENGLISH "not a 64-bit integer: ~"
  354.             //: FRANCAIS "Ceci n'est pas un nombre à 64 bits : ~"
  355.             fehler(type_error, GETTEXT("not a 64-bit integer: ~"));
  356.     }   }
  357.  
  358. #endif
  359. #if defined(HAVE_FFI) && defined(HAVE_LONGLONG)
  360.  
  361. # Wandelt Integer in Signed Quadword um.
  362. # I_to_Q(obj)
  363. # > obj: ein Objekt, sollte ein Integer >=-2^63, <2^63 sein
  364. # < ergebnis: der Wert des Integer als 64-Bit-Zahl.
  365.   global sint64 I_to_Q (object obj);
  366.   global sint64 I_to_Q(obj)
  367.     var reg2 object obj;
  368.     { switch (typecode(obj))
  369.         { case_posfixnum: # Fixnum >=0
  370.             return (uint64)posfixnum_to_L(obj);
  371.           case_posbignum: # Bignum >0
  372.             { var reg1 Bignum bn = TheBignum(obj);
  373.               var reg3 uintC len = bn->length;
  374.               #define IF_LENGTH(i)  \
  375.                 if (bn_minlength <= i) # genau i Digits überhaupt möglich?       \
  376.                   if (len == i) # genau i Digits?                                \
  377.                     # 2^((i-1)*intDsize-1) <= obj < 2^(i*intDsize-1)             \
  378.                     if ( (i*intDsize > 64)                                       \
  379.                          && ( ((i-1)*intDsize >= 64)                             \
  380.                               || (bn->data[0] >= (uintD)bitc(63-(i-1)*intDsize)) \
  381.                        )    )                                                    \
  382.                       goto bad;                                                  \
  383.                       else
  384.               #if (intDsize==32)
  385.               IF_LENGTH(1)
  386.                 return (uint64)get_uint1D_Dptr(bn->data);
  387.               IF_LENGTH(2)
  388.                 return ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint1D_Dptr(&bn->data[1]);
  389.               #endif
  390.               #if (intDsize==16)
  391.               IF_LENGTH(1)
  392.                 return (uint64)get_uint1D_Dptr(bn->data);
  393.               IF_LENGTH(2)
  394.                 return (uint64)get_uint2D_Dptr(bn->data);
  395.               IF_LENGTH(3)
  396.                 return ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[1]);
  397.               IF_LENGTH(4)
  398.                 return ((uint64)get_uint2D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[2]);
  399.               #endif
  400.               #if (intDsize==8)
  401.               IF_LENGTH(1)
  402.                 return (uint64)get_uint1D_Dptr(bn->data);
  403.               IF_LENGTH(2)
  404.                 return (uint64)get_uint2D_Dptr(bn->data);
  405.               IF_LENGTH(3)
  406.                 return (uint64)get_uint3D_Dptr(bn->data);
  407.               IF_LENGTH(4)
  408.                 return (uint64)get_uint4D_Dptr(bn->data);
  409.               IF_LENGTH(5)
  410.                 return ((uint64)get_uint1D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[1]);
  411.               IF_LENGTH(6)
  412.                 return ((uint64)get_uint2D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[2]);
  413.               IF_LENGTH(7)
  414.                 return ((uint64)get_uint3D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[3]);
  415.               IF_LENGTH(8)
  416.                 return ((uint64)get_uint4D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[4]);
  417.               #endif
  418.               #undef IF_LENGTH
  419.               goto bad;
  420.             }
  421.           case_negfixnum: # Fixnum <0
  422.             return (uint64)(uintL)negfixnum_to_L(obj) | (-wbitm(intLsize));
  423.           case_negbignum: # Bignum <0
  424.             { var reg1 Bignum bn = TheBignum(obj);
  425.               var reg3 uintC len = bn->length;
  426.               #define IF_LENGTH(i)  \
  427.                 if (bn_minlength <= i) # genau i Digits überhaupt möglich?         \
  428.                   if (len == i) # genau i Digits?                                  \
  429.                     # - 2^(i*intDsize-1) <= obj < - 2^((i-1)*intDsize-1)           \
  430.                     if ( (i*intDsize > 64)                                         \
  431.                          && ( ((i-1)*intDsize >= 64)                               \
  432.                               || (bn->data[0] < (uintD)(-bitc(63-(i-1)*intDsize))) \
  433.                        )    )                                                      \
  434.                       goto bad;                                                    \
  435.                       else
  436.               #if (intDsize==32)
  437.               IF_LENGTH(1)
  438.                 return (sint64)get_sint1D_Dptr(bn->data);
  439.               IF_LENGTH(2)
  440.                 return ((sint64)get_sint1D_Dptr(bn->data) << 32) | (uint64)get_uint1D_Dptr(&bn->data[1]);
  441.               #endif
  442.               #if (intDsize==16)
  443.               IF_LENGTH(1)
  444.                 return (sint64)get_sint1D_Dptr(bn->data);
  445.               IF_LENGTH(2)
  446.                 return (sint64)get_sint2D_Dptr(bn->data);
  447.               IF_LENGTH(3)
  448.                 return ((sint64)get_sint1D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[1]);
  449.               IF_LENGTH(4)
  450.                 return ((sint64)get_sint2D_Dptr(bn->data) << 32) | (uint64)get_uint2D_Dptr(&bn->data[2]);
  451.               #endif
  452.               #if (intDsize==8)
  453.               IF_LENGTH(1)
  454.                 return (sint64)get_sint1D_Dptr(bn->data);
  455.               IF_LENGTH(2)
  456.                 return (sint64)get_sint2D_Dptr(bn->data);
  457.               IF_LENGTH(3)
  458.                 return (sint64)get_sint3D_Dptr(bn->data);
  459.               IF_LENGTH(4)
  460.                 return (sint64)get_sint4D_Dptr(bn->data);
  461.               IF_LENGTH(5)
  462.                 return ((sint64)get_sint1D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[1]);
  463.               IF_LENGTH(6)
  464.                 return ((sint64)get_sint2D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[2]);
  465.               IF_LENGTH(7)
  466.                 return ((sint64)get_sint3D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[3]);
  467.               IF_LENGTH(8)
  468.                 return ((sint64)get_sint4D_Dptr(bn->data) << 32) | (uint64)get_uint4D_Dptr(&bn->data[4]);
  469.               #endif
  470.               #undef IF_LENGTH
  471.               goto bad;
  472.             }
  473.           default:
  474.           bad: # unpassendes Objekt
  475.             pushSTACK(obj); # Wert für Slot DATUM von TYPE-ERROR
  476.             pushSTACK(O(type_sint64)); # Wert für Slot EXPECTED-TYPE von TYPE-ERROR
  477.             pushSTACK(obj);
  478.             //: DEUTSCH "Das ist keine 64-Bit-Zahl: ~"
  479.             //: ENGLISH "not a 64-bit integer: ~"
  480.             //: FRANCAIS "Ceci n'est pas un nombre à 64 bits : ~"
  481.             fehler(type_error, GETTEXT("not a 64-bit integer: ~"));
  482.     }   }
  483.  
  484. #endif
  485.  
  486. # Wandelt Longword in Fixnum um.
  487. # L_to_FN(wert)
  488. # > wert: Wert des Fixnums, ein signed 32-Bit-Integer
  489. #         >= -2^oint_data_len, < 2^oint_data_len
  490. # < ergebnis: Fixnum mit diesem Wert.
  491. # wert sollte eine Variable sein.
  492.   #if (oint_data_shift <= vorz_bit_o)
  493.     #define L_to_FN(wert)  \
  494.       as_object((( (soint)(sint32)(wert)                                          \
  495.                    & (FN_value_vz_mask>>oint_data_shift) # Unnötiges wegmaskieren \
  496.                  ) << oint_data_shift                                             \
  497.                 )                                                                 \
  498.                 | ((oint)fixnum_type<<oint_type_shift) # dafür Typinfo rein       \
  499.                )
  500.   #else # (oint_data_shift > vorz_bit_o)
  501.     #define L_to_FN(wert)  \
  502.       as_object((( (soint)(sint32)(wert) << oint_data_shift )                       \
  503.                  & FN_value_mask # Unnötiges wegmaskieren                           \
  504.                 )                                                                   \
  505.                 | ((soint)(sint32)sign_of_sint32((sint32)(wert)) & bit(vorz_bit_o)) \
  506.                 | ((oint)fixnum_type<<oint_type_shift) # dafür Typinfo rein         \
  507.                )
  508.   #endif
  509.  
  510. # Wandelt Longword in Integer um.
  511. # L_to_I(wert)
  512. # > wert: Wert des Integers, ein signed 32-Bit-Integer.
  513. # < ergebnis: Integer mit diesem Wert.
  514. # kann GC auslösen
  515.   global object L_to_I (sint32 wert);
  516.   #if (oint_data_len+1 >= intLsize)
  517.   inline global object L_to_I(wert)
  518.     var reg2 sint32 wert;
  519.     { return L_to_FN(wert); }
  520.   #else
  521.   global object L_to_I(wert)
  522.     var reg2 sint32 wert;
  523.     {{var reg1 uint32 test = wert & (uint32)(~(FN_value_mask >> oint_data_shift));
  524.       # test enthält die Bits, die nicht in den Fixnum-Wert reinpassen.
  525.       if (test == (uint32)0) # alle =0 ?
  526.         return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)wert<<oint_data_shift));
  527.       if (test == (uint32)(~(FN_value_mask >> oint_data_shift))) # alle =1 ?
  528.         return as_object(((((oint)fixnum_vz_type<<oint_type_shift)+FN_value_mask) & ((oint)wert<<oint_data_shift))
  529.                          |(((oint)fixnum_vz_type<<oint_type_shift) & (wbit(oint_data_shift)-1))
  530.                         );
  531.      }
  532.       # Bignum erzeugen:
  533.       # (dessen Länge  bn_minlength <= n <= ceiling(32/intDsize)  erfüllt)
  534.       if (bn_minlength == ceiling(32,intDsize))
  535.         #if (intDsize==8)
  536.         { if (wert >= 0) goto pos4; else goto neg4; } # Bignum mit 32/intDsize = 4 Digits
  537.         #endif
  538.         #if (intDsize==16)
  539.         { if (wert >= 0) goto pos2; else goto neg2; } # Bignum mit 32/intDsize = 2 Digits
  540.         #endif
  541.         #if (intDsize==32)
  542.         { if (wert >= 0) goto pos1; else goto neg1; } # Bignum mit 32/intDsize = 1 Digits
  543.         #endif
  544.       else
  545.         {
  546.           #define FILL_1_DIGIT(from)  \
  547.             *ptr-- = (uintD)from;
  548.           #define FILL_2_DIGITS(from)  \
  549.             *ptr-- = (uintD)from; from = from >> intDsize; \
  550.             *ptr-- = (uintD)from;
  551.           #define FILL_3_DIGITS(from)  \
  552.             *ptr-- = (uintD)from; from = from >> intDsize; \
  553.             *ptr-- = (uintD)from; from = from >> intDsize; \
  554.             *ptr-- = (uintD)from;
  555.           #define FILL_4_DIGITS(from)  \
  556.             *ptr-- = (uintD)from; from = from >> intDsize; \
  557.             *ptr-- = (uintD)from; from = from >> intDsize; \
  558.             *ptr-- = (uintD)from; from = from >> intDsize; \
  559.             *ptr-- = (uintD)from;
  560.           #define FILL_1  FILL_1_DIGIT(wert);
  561.           #define FILL_2  FILL_2_DIGITS(wert);
  562.           #define FILL_3  FILL_3_DIGITS(wert);
  563.           #define FILL_4  FILL_4_DIGITS(wert);
  564.           #define OK  return new;
  565.           if (wert >= 0)
  566.             {
  567.               #define ALLOC(i)  \
  568.                 var reg2 object new = allocate_bignum(i,0); \
  569.                 var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
  570.               #define IF_LENGTH(i)  \
  571.                 if ((bn_minlength <= i) && (i*intDsize <= 32))       \
  572.                   if (!((i+1)*intDsize <= 32)                        \
  573.                       || ((uint32)wert < (uint32)bitc(i*intDsize-1)) \
  574.                      )
  575.               #if (intDsize <= 32)
  576.               IF_LENGTH(1)
  577.                 pos1:
  578.                 { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
  579.               #if (intDsize <= 16)
  580.               IF_LENGTH(2)
  581.                 pos2:
  582.                 { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
  583.               #if (intDsize <= 8)
  584.               IF_LENGTH(3)
  585.                 { ALLOC(3); FILL_3; OK; } # Bignum mit 3 Digits
  586.               IF_LENGTH(4)
  587.                 pos4:
  588.                 { ALLOC(4); FILL_4; OK; } # Bignum mit 4 Digits
  589.               #endif
  590.               #endif
  591.               #endif
  592.               #undef IF_LENGTH
  593.               #undef ALLOC
  594.             }
  595.             else
  596.             {
  597.               #define ALLOC(i)  \
  598.                 var reg2 object new = allocate_bignum(i,-1); \
  599.                 var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
  600.               #define IF_LENGTH(i)  \
  601.                 if ((bn_minlength <= i) && (i*intDsize <= 32))           \
  602.                   if (!((i+1)*intDsize <= 32)                            \
  603.                       || ((uint32)wert >= (uint32)(-bitc(i*intDsize-1))) \
  604.                      )
  605.               #if (intDsize <= 32)
  606.               IF_LENGTH(1)
  607.                 neg1:
  608.                 { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
  609.               #if (intDsize <= 16)
  610.               IF_LENGTH(2)
  611.                 neg2:
  612.                 { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
  613.               #if (intDsize <= 8)
  614.               IF_LENGTH(3)
  615.                 { ALLOC(3); FILL_3; OK; } # Bignum mit 3 Digits
  616.               IF_LENGTH(4)
  617.                 neg4:
  618.                 { ALLOC(4); FILL_4; OK; } # Bignum mit 4 Digits
  619.               #endif
  620.               #endif
  621.               #endif
  622.               #undef IF_LENGTH
  623.               #undef ALLOC
  624.             }
  625.           #undef OK
  626.           #undef FILL_4
  627.           #undef FILL_3
  628.           #undef FILL_2
  629.           #undef FILL_1
  630.           #undef FILL_4_DIGITS
  631.           #undef FILL_3_DIGITS
  632.           #undef FILL_2_DIGITS
  633.           #undef FILL_1_DIGIT
  634.         }
  635.     }
  636.   #endif
  637.  
  638. # Wandelt Unsigned Longword in Integer >=0 um.
  639. # UL_to_I(wert)
  640. # > wert: Wert des Integers, ein unsigned 32-Bit-Integer.
  641. # < ergebnis: Integer mit diesem Wert.
  642. # kann GC auslösen
  643. #ifndef UL_to_I # wenn nicht schon als Macro definiert
  644.   global object UL_to_I (uint32 wert);
  645.   global object UL_to_I(wert)
  646.     var reg2 uint32 wert;
  647.     { if ((wert & ~ (FN_value_mask >> oint_data_shift)) == 0)
  648.         # alle Bits, die nicht in den Fixnum-Wert reinpassen, =0 ?
  649.         return as_object(((oint)fixnum_type<<oint_type_shift) | (wert<<oint_data_shift));
  650.       # Bignum erzeugen:
  651.       # (dessen Länge  bn_minlength <= n <= ceiling((32+1)/intDsize)  erfüllt)
  652.       #define UL_maxlength  ceiling(32+1,intDsize)
  653.       #if (bn_minlength <= 1) && (UL_maxlength >= 1)
  654.       if ((1*intDsize-1 < 32)
  655.           ? (wert <= (uint32)(bitc(1*intDsize-1)-1))
  656.           : TRUE
  657.          )
  658.         # Bignum mit 1 Digit
  659.         { var reg1 object new = allocate_bignum(1,0);
  660.           TheBignum(new)->data[0] = (uintD)wert;
  661.           return new;
  662.         }
  663.       #endif
  664.       #if (bn_minlength <= 2) && (UL_maxlength >= 2)
  665.       if ((2*intDsize-1 < 32)
  666.           ? (wert <= (uint32)(bitc(2*intDsize-1)-1))
  667.           : TRUE
  668.          )
  669.         # Bignum mit 2 Digits
  670.         { var reg2 object new = allocate_bignum(2,0);
  671.           var reg1 uintD* ptr = &TheBignum(new)->data[1];
  672.           *ptr-- = (uintD)wert;
  673.           #if (intDsize>=32)
  674.             *ptr = 0;
  675.           #else
  676.             wert = wert >> intDsize; *ptr = (uintD)wert;
  677.           #endif
  678.           return new;
  679.         }
  680.       #endif
  681.       #if (bn_minlength <= 3) && (UL_maxlength >= 3)
  682.       if ((3*intDsize-1 < 32)
  683.           ? (wert <= (uint32)(bitc(3*intDsize-1)-1))
  684.           : TRUE
  685.          )
  686.         # Bignum mit 3 Digits
  687.         { var reg2 object new = allocate_bignum(3,0);
  688.           var reg1 uintD* ptr = &TheBignum(new)->data[2];
  689.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  690.           *ptr-- = (uintD)wert;
  691.           #if (2*intDsize>=32)
  692.             *ptr = 0;
  693.           #else
  694.             wert = wert >> intDsize; *ptr = (uintD)wert;
  695.           #endif
  696.           return new;
  697.         }
  698.       #endif
  699.       #if (bn_minlength <= 4) && (UL_maxlength >= 4)
  700.       if ((4*intDsize-1 < 32)
  701.           ? (wert <= (uint32)(bitc(4*intDsize-1)-1))
  702.           : TRUE
  703.          )
  704.         # Bignum mit 4 Digits
  705.         { var reg2 object new = allocate_bignum(4,0);
  706.           var reg1 uintD* ptr = &TheBignum(new)->data[3];
  707.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  708.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  709.           *ptr-- = (uintD)wert;
  710.           #if (3*intDsize>=32)
  711.             *ptr = 0;
  712.           #else
  713.             wert = wert >> intDsize; *ptr = (uintD)wert;
  714.           #endif
  715.           return new;
  716.         }
  717.       #endif
  718.       #if (bn_minlength <= 5) && (UL_maxlength >= 5)
  719.       if (TRUE)
  720.         # Bignum mit 5 Digits
  721.         { var reg2 object new = allocate_bignum(5,0);
  722.           var reg1 uintD* ptr = &TheBignum(new)->data[4];
  723.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  724.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  725.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  726.           *ptr-- = (uintD)wert;
  727.           #if (4*intDsize>=32)
  728.             *ptr = 0;
  729.           #else
  730.             wert = wert >> intDsize; *ptr = (uintD)wert;
  731.           #endif
  732.           return new;
  733.         }
  734.       #endif
  735.     }
  736. #endif
  737.  
  738. # Wandelt Doppel-Longword in Integer um.
  739. # L2_to_I(wert_hi,wert_lo)
  740. # > wert_hi|wert_lo: Wert des Integers, ein signed 64-Bit-Integer.
  741. # < ergebnis: Integer mit diesem Wert.
  742. # kann GC auslösen
  743.   global object L2_to_I (sint32 wert_hi, uint32 wert_lo);
  744.   global object L2_to_I(wert_hi,wert_lo)
  745.     var reg2 sint32 wert_hi;
  746.     var reg2 uint32 wert_lo;
  747.     { if (wert_hi == 0)
  748.         { if ((wert_lo & (uint32)(~(FN_value_mask >> oint_data_shift))) # Bits von wert_lo, die nicht in den Fixnum-Wert passen
  749.               == (uint32)0                                              # alle =0 ?
  750.              )
  751.             return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)wert_lo<<oint_data_shift));
  752.         }
  753.       elif (wert_hi == ~(uintL)0)
  754.         { if ((wert_lo & (uint32)(~(FN_value_mask >> oint_data_shift))) # Bits von wert_lo, die nicht in den Fixnum-Wert passen
  755.               == (uint32)(~(FN_value_mask >> oint_data_shift))          # alle =1 ?
  756.              )
  757.             #ifndef WIDE
  758.             return as_object(((((oint)fixnum_vz_type<<oint_type_shift)+FN_value_mask) & (wert_lo<<oint_data_shift))
  759.                              |(((oint)fixnum_vz_type<<oint_type_shift) & (wbit(oint_data_shift)-1))
  760.                             );
  761.             #else
  762.             return as_object(((oint)fixnum_vz_type<<oint_type_shift) | ((oint)(wert_lo & (uint32)(FN_value_mask >> oint_data_shift)) << oint_data_shift));
  763.             #endif
  764.         }
  765.       # Bignum erzeugen:
  766.       # (dessen Länge  bn_minlength <= n <= ceiling(64/intDsize)  erfüllt)
  767.       #define FILL_1_DIGIT(from)  \
  768.         *ptr-- = (uintD)from;
  769.       #define FILL_2_DIGITS(from)  \
  770.         *ptr-- = (uintD)from; from = from >> intDsize; \
  771.         *ptr-- = (uintD)from;
  772.       #define FILL_3_DIGITS(from)  \
  773.         *ptr-- = (uintD)from; from = from >> intDsize; \
  774.         *ptr-- = (uintD)from; from = from >> intDsize; \
  775.         *ptr-- = (uintD)from;
  776.       #define FILL_4_DIGITS(from)  \
  777.         *ptr-- = (uintD)from; from = from >> intDsize; \
  778.         *ptr-- = (uintD)from; from = from >> intDsize; \
  779.         *ptr-- = (uintD)from; from = from >> intDsize; \
  780.         *ptr-- = (uintD)from;
  781.       #if (32/intDsize==1)
  782.       #define FILL_1  FILL_1_DIGIT(wert_lo);
  783.       #define FILL_2  FILL_1_DIGIT(wert_lo); FILL_1_DIGIT(wert_hi);
  784.       #define FILL_3
  785.       #define FILL_4
  786.       #define FILL_5
  787.       #define FILL_6
  788.       #define FILL_7
  789.       #define FILL_8
  790.       #endif
  791.       #if (32/intDsize==2)
  792.       #define FILL_1  FILL_1_DIGIT(wert_lo);
  793.       #define FILL_2  FILL_2_DIGITS(wert_lo);
  794.       #define FILL_3  FILL_2_DIGITS(wert_lo); FILL_1_DIGIT(wert_hi);
  795.       #define FILL_4  FILL_2_DIGITS(wert_lo); FILL_2_DIGITS(wert_hi);
  796.       #define FILL_5
  797.       #define FILL_6
  798.       #define FILL_7
  799.       #define FILL_8
  800.       #endif
  801.       #if (32/intDsize==4)
  802.       #define FILL_1  FILL_1_DIGIT(wert_lo);
  803.       #define FILL_2  FILL_2_DIGITS(wert_lo);
  804.       #define FILL_3  FILL_3_DIGITS(wert_lo);
  805.       #define FILL_4  FILL_4_DIGITS(wert_lo);
  806.       #define FILL_5  FILL_4_DIGITS(wert_lo); FILL_1_DIGIT(wert_hi);
  807.       #define FILL_6  FILL_4_DIGITS(wert_lo); FILL_2_DIGITS(wert_hi);
  808.       #define FILL_7  FILL_4_DIGITS(wert_lo); FILL_3_DIGITS(wert_hi);
  809.       #define FILL_8  FILL_4_DIGITS(wert_lo); FILL_4_DIGITS(wert_hi);
  810.       #endif
  811.       #define OK  return new;
  812.       if (wert_hi >= 0)
  813.         {
  814.           #define ALLOC(i)  \
  815.             var reg2 object new = allocate_bignum(i,0); \
  816.             var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
  817.           #define IF_LENGTH(i)  \
  818.             if ((bn_minlength <= i) && (i*intDsize <= 64))                         \
  819.               if (!((i+1)*intDsize <= 64)                                          \
  820.                   || (i*intDsize-1 < 32                                            \
  821.                       ? ((wert_hi == 0) && (wert_lo < (uint32)bitc(i*intDsize-1))) \
  822.                       : ((uint32)wert_hi < (uint32)bitc(i*intDsize-1-32))          \
  823.                  )   )
  824.           IF_LENGTH(1)
  825.             { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
  826.           IF_LENGTH(2)
  827.             { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
  828.           IF_LENGTH(3)
  829.             { ALLOC(3); FILL_3; OK; } # Bignum mit 3 Digits
  830.           IF_LENGTH(4)
  831.             { ALLOC(4); FILL_4; OK; } # Bignum mit 4 Digits
  832.           IF_LENGTH(5)
  833.             { ALLOC(5); FILL_5; OK; } # Bignum mit 5 Digits
  834.           IF_LENGTH(6)
  835.             { ALLOC(6); FILL_6; OK; } # Bignum mit 6 Digits
  836.           IF_LENGTH(7)
  837.             { ALLOC(7); FILL_7; OK; } # Bignum mit 7 Digits
  838.           IF_LENGTH(8)
  839.             { ALLOC(8); FILL_8; OK; } # Bignum mit 8 Digits
  840.           #undef IF_LENGTH
  841.           #undef ALLOC
  842.         }
  843.         else
  844.         {
  845.           #define ALLOC(i)  \
  846.             var reg2 object new = allocate_bignum(i,-1); \
  847.             var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
  848.           #define IF_LENGTH(i)  \
  849.             if ((bn_minlength <= i) && (i*intDsize <= 64))                    \
  850.               if (!((i+1)*intDsize <= 64)                                     \
  851.                   || (i*intDsize-1 < 32                                       \
  852.                       ? ((wert_hi == ~(uint32)0) && (wert_lo >= (uint32)(-bitc(i*intDsize-1)))) \
  853.                       : ((uint32)wert_hi >= (uint32)(-bitc(i*intDsize-1-32))) \
  854.                  )   )
  855.           IF_LENGTH(1)
  856.             { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
  857.           IF_LENGTH(2)
  858.             { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
  859.           IF_LENGTH(3)
  860.             { ALLOC(3); FILL_3; OK; } # Bignum mit 3 Digits
  861.           IF_LENGTH(4)
  862.             { ALLOC(4); FILL_4; OK; } # Bignum mit 4 Digits
  863.           IF_LENGTH(5)
  864.             { ALLOC(5); FILL_5; OK; } # Bignum mit 5 Digits
  865.           IF_LENGTH(6)
  866.             { ALLOC(6); FILL_6; OK; } # Bignum mit 6 Digits
  867.           IF_LENGTH(7)
  868.             { ALLOC(7); FILL_7; OK; } # Bignum mit 7 Digits
  869.           IF_LENGTH(8)
  870.             { ALLOC(8); FILL_8; OK; } # Bignum mit 8 Digits
  871.           #undef IF_LENGTH
  872.           #undef ALLOC
  873.         }
  874.       #undef OK
  875.       #undef FILL_8
  876.       #undef FILL_7
  877.       #undef FILL_6
  878.       #undef FILL_5
  879.       #undef FILL_4
  880.       #undef FILL_3
  881.       #undef FILL_2
  882.       #undef FILL_1
  883.       #undef FILL_4_DIGITS
  884.       #undef FILL_3_DIGITS
  885.       #undef FILL_2_DIGITS
  886.       #undef FILL_1_DIGIT
  887.     }
  888.  
  889. #ifdef HAVE_FFI
  890. # Wandelt Unsigned Doppel-Longword in Integer um.
  891. # UL2_to_I(wert_hi,wert_lo)
  892. # > wert_hi|wert_lo: Wert des Integers, ein unsigned 64-Bit-Integer.
  893. # < ergebnis: Integer mit diesem Wert.
  894. # kann GC auslösen
  895.   global object UL2_to_I (uint32 wert_hi, uint32 wert_lo);
  896.   global object UL2_to_I(wert_hi,wert_lo)
  897.     var reg2 uint32 wert_hi;
  898.     var reg2 uint32 wert_lo;
  899.     { if ((wert_hi == 0)
  900.           && ((wert_lo & (uint32)(~(FN_value_mask >> oint_data_shift))) # Bits von wert_lo, die nicht in den Fixnum-Wert passen
  901.                == (uint32)0                                             # alle =0 ?
  902.          )   )
  903.         return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)wert_lo<<oint_data_shift));
  904.       # Bignum erzeugen:
  905.       # (dessen Länge  bn_minlength <= n <= ceiling((64+1)/intDsize)  erfüllt)
  906.       #define UL2_maxlength  ceiling(64+1,intDsize)
  907.       #define FILL_1_DIGIT(from)  \
  908.         *ptr-- = (uintD)from;
  909.       #define FILL_2_DIGITS(from)  \
  910.         *ptr-- = (uintD)from; from = from >> intDsize; \
  911.         *ptr-- = (uintD)from;
  912.       #define FILL_3_DIGITS(from)  \
  913.         *ptr-- = (uintD)from; from = from >> intDsize; \
  914.         *ptr-- = (uintD)from; from = from >> intDsize; \
  915.         *ptr-- = (uintD)from;
  916.       #define FILL_4_DIGITS(from)  \
  917.         *ptr-- = (uintD)from; from = from >> intDsize; \
  918.         *ptr-- = (uintD)from; from = from >> intDsize; \
  919.         *ptr-- = (uintD)from; from = from >> intDsize; \
  920.         *ptr-- = (uintD)from;
  921.       #if (32/intDsize==1)
  922.       #define FILL_1  FILL_1_DIGIT(wert_lo);
  923.       #define FILL_2  FILL_1_DIGIT(wert_lo); FILL_1_DIGIT(wert_hi);
  924.       #define FILL_3  FILL_2 *ptr-- = 0;
  925.       #define FILL_4
  926.       #define FILL_5
  927.       #define FILL_6
  928.       #define FILL_7
  929.       #define FILL_8
  930.       #define FILL_9
  931.       #endif
  932.       #if (32/intDsize==2)
  933.       #define FILL_1  FILL_1_DIGIT(wert_lo);
  934.       #define FILL_2  FILL_2_DIGITS(wert_lo);
  935.       #define FILL_3  FILL_2_DIGITS(wert_lo); FILL_1_DIGIT(wert_hi);
  936.       #define FILL_4  FILL_2_DIGITS(wert_lo); FILL_2_DIGITS(wert_hi);
  937.       #define FILL_5  FILL_4 *ptr-- = 0;
  938.       #define FILL_6
  939.       #define FILL_7
  940.       #define FILL_8
  941.       #define FILL_9
  942.       #endif
  943.       #if (32/intDsize==4)
  944.       #define FILL_1  FILL_1_DIGIT(wert_lo);
  945.       #define FILL_2  FILL_2_DIGITS(wert_lo);
  946.       #define FILL_3  FILL_3_DIGITS(wert_lo);
  947.       #define FILL_4  FILL_4_DIGITS(wert_lo);
  948.       #define FILL_5  FILL_4_DIGITS(wert_lo); FILL_1_DIGIT(wert_hi);
  949.       #define FILL_6  FILL_4_DIGITS(wert_lo); FILL_2_DIGITS(wert_hi);
  950.       #define FILL_7  FILL_4_DIGITS(wert_lo); FILL_3_DIGITS(wert_hi);
  951.       #define FILL_8  FILL_4_DIGITS(wert_lo); FILL_4_DIGITS(wert_hi);
  952.       #define FILL_9  FILL_8 *ptr-- = 0;
  953.       #endif
  954.       #define OK  return new;
  955.       #define ALLOC(i)  \
  956.         var reg2 object new = allocate_bignum(i,0); \
  957.         var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
  958.       #define IF_LENGTH(i)  \
  959.         if ((bn_minlength <= i) && (UL2_maxlength >= i))                       \
  960.           if ((i*intDsize >= 64+1)                                             \
  961.               || (i*intDsize-1 < 32                                            \
  962.                   ? ((wert_hi == 0) && (wert_lo < (uint32)bitc(i*intDsize-1))) \
  963.                   : (wert_hi < (uint32)bitc(i*intDsize-1-32))                  \
  964.              )   )
  965.       IF_LENGTH(1)
  966.         { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
  967.       IF_LENGTH(2)
  968.         { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
  969.       IF_LENGTH(3)
  970.         { ALLOC(3); FILL_3; OK; } # Bignum mit 3 Digits
  971.       IF_LENGTH(4)
  972.         { ALLOC(4); FILL_4; OK; } # Bignum mit 4 Digits
  973.       IF_LENGTH(5)
  974.         { ALLOC(5); FILL_5; OK; } # Bignum mit 5 Digits
  975.       IF_LENGTH(6)
  976.         { ALLOC(6); FILL_6; OK; } # Bignum mit 6 Digits
  977.       IF_LENGTH(7)
  978.         { ALLOC(7); FILL_7; OK; } # Bignum mit 7 Digits
  979.       IF_LENGTH(8)
  980.         { ALLOC(8); FILL_8; OK; } # Bignum mit 8 Digits
  981.       IF_LENGTH(8)
  982.         { ALLOC(9); FILL_9; OK; } # Bignum mit 9 Digits
  983.       #undef IF_LENGTH
  984.       #undef ALLOC
  985.       #undef OK
  986.       #undef FILL_9
  987.       #undef FILL_8
  988.       #undef FILL_7
  989.       #undef FILL_6
  990.       #undef FILL_5
  991.       #undef FILL_4
  992.       #undef FILL_3
  993.       #undef FILL_2
  994.       #undef FILL_1
  995.       #undef FILL_4_DIGITS
  996.       #undef FILL_3_DIGITS
  997.       #undef FILL_2_DIGITS
  998.       #undef FILL_1_DIGIT
  999.     }
  1000. #endif
  1001.  
  1002. #ifdef HAVE_FFI
  1003. #ifdef intQsize
  1004. # Wandelt Quadword in Integer um.
  1005. # Q_to_I(wert)
  1006. # > wert: Wert des Integers, ein signed 64-Bit-Integer.
  1007. # < ergebnis: Integer mit diesem Wert.
  1008. # kann GC auslösen
  1009.   global object Q_to_I (sint64 wert);
  1010.   global object Q_to_I(wert)
  1011.     var reg2 sint64 wert;
  1012.     {{var reg1 uint64 test = wert & ~(uint64)(FN_value_mask >> oint_data_shift);
  1013.       # test enthält die Bits, die nicht in den Fixnum-Wert reinpassen.
  1014.       if (test == (uint64)0) # alle =0 ?
  1015.         return as_object(((oint)fixnum_type<<oint_type_shift) | ((oint)wert<<oint_data_shift));
  1016.       if (test == ~(uint64)(FN_value_mask >> oint_data_shift)) # alle =1 ?
  1017.         return as_object(((((oint)fixnum_vz_type<<oint_type_shift)+FN_value_mask) & ((oint)wert<<oint_data_shift))
  1018.                          |(((oint)fixnum_vz_type<<oint_type_shift) & (wbit(oint_data_shift)-1))
  1019.                         );
  1020.      }
  1021.       # Bignum erzeugen:
  1022.       # (dessen Länge  bn_minlength <= n <= ceiling(64/intDsize) = 2  erfüllt)
  1023.       #define FILL_1_DIGIT(from)  \
  1024.         *ptr-- = (uintD)from;
  1025.       #define FILL_2_DIGITS(from)  \
  1026.         *ptr-- = (uintD)from; from = from >> intDsize; \
  1027.         *ptr-- = (uintD)from;
  1028.       #define FILL_1  FILL_1_DIGIT(wert);
  1029.       #define FILL_2  FILL_2_DIGITS(wert);
  1030.       #define OK  return new;
  1031.       if (wert >= 0)
  1032.         {
  1033.           #define ALLOC(i)  \
  1034.             var reg2 object new = allocate_bignum(i,0); \
  1035.             var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
  1036.           #define IF_LENGTH(i)  \
  1037.             if ((bn_minlength <= i) && (i*intDsize <= 64))      \
  1038.               if (!((i+1)*intDsize <= 64)                       \
  1039.                   || ((uint64)wert < (uint64)bit(i*intDsize-1)) \
  1040.                  )
  1041.           IF_LENGTH(1)
  1042.             { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
  1043.           IF_LENGTH(2)
  1044.             { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
  1045.           #undef IF_LENGTH
  1046.           #undef ALLOC
  1047.         }
  1048.         else
  1049.         {
  1050.           #define ALLOC(i)  \
  1051.             var reg2 object new = allocate_bignum(i,-1); \
  1052.             var reg1 uintD* ptr = &TheBignum(new)->data[i-1];
  1053.           #define IF_LENGTH(i)  \
  1054.             if ((bn_minlength <= i) && (i*intDsize <= 64))          \
  1055.               if (!((i+1)*intDsize <= 64)                           \
  1056.                   || ((uint64)wert >= (uint64)(-bit(i*intDsize-1))) \
  1057.                  )
  1058.           IF_LENGTH(1)
  1059.             { ALLOC(1); FILL_1; OK; } # Bignum mit 1 Digit
  1060.           IF_LENGTH(2)
  1061.             { ALLOC(2); FILL_2; OK; } # Bignum mit 2 Digits
  1062.           #undef IF_LENGTH
  1063.           #undef ALLOC
  1064.         }
  1065.       #undef OK
  1066.       #undef FILL_2
  1067.       #undef FILL_1
  1068.       #undef FILL_2_DIGITS
  1069.       #undef FILL_1_DIGIT
  1070.     }
  1071. #endif
  1072. #endif
  1073.  
  1074. #if defined(intQsize) || defined(WIDE_HARD)
  1075. # Wandelt Unsigned Quadword in Integer >=0 um.
  1076. # UQ_to_I(wert)
  1077. # > wert: Wert des Integers, ein unsigned 64-Bit-Integer.
  1078. # < ergebnis: Integer mit diesem Wert.
  1079. # kann GC auslösen
  1080.   global object UQ_to_I (uint64 wert);
  1081.   global object UQ_to_I(wert)
  1082.     var reg2 uint64 wert;
  1083.     { if ((wert & ~ (FN_value_mask >> oint_data_shift)) == 0)
  1084.         # alle Bits, die nicht in den Fixnum-Wert reinpassen, =0 ?
  1085.         return as_object(((oint)fixnum_type<<oint_type_shift) | (wert<<oint_data_shift));
  1086.       # Bignum erzeugen:
  1087.       # (dessen Länge  bn_minlength <= n <= ceiling((64+1)/intDsize)  erfüllt)
  1088.       #define UQ_maxlength  ceiling(64+1,intDsize)
  1089.       #if (bn_minlength <= 1) && (UQ_maxlength >= 1)
  1090.       if ((1*intDsize-1 < 64)
  1091.           ? (wert <= (uint64)(bitc(1*intDsize-1)-1))
  1092.           : TRUE
  1093.          )
  1094.         # Bignum mit 1 Digit
  1095.         { var reg1 object new = allocate_bignum(1,0);
  1096.           TheBignum(new)->data[0] = (uintD)wert;
  1097.           return new;
  1098.         }
  1099.       #endif
  1100.       #if (bn_minlength <= 2) && (UQ_maxlength >= 2)
  1101.       if ((2*intDsize-1 < 64)
  1102.           ? (wert <= (uint64)(bitc(2*intDsize-1)-1))
  1103.           : TRUE
  1104.          )
  1105.         # Bignum mit 2 Digits
  1106.         { var reg2 object new = allocate_bignum(2,0);
  1107.           var reg1 uintD* ptr = &TheBignum(new)->data[1];
  1108.           *ptr-- = (uintD)wert;
  1109.           #if (intDsize>=64)
  1110.             *ptr = 0;
  1111.           #else
  1112.             wert = wert >> intDsize; *ptr = (uintD)wert;
  1113.           #endif
  1114.           return new;
  1115.         }
  1116.       #endif
  1117.       #if (bn_minlength <= 3) && (UQ_maxlength >= 3)
  1118.       if ((3*intDsize-1 < 64)
  1119.           ? (wert <= (uint64)(bitc(3*intDsize-1)-1))
  1120.           : TRUE
  1121.          )
  1122.         # Bignum mit 3 Digits
  1123.         { var reg2 object new = allocate_bignum(3,0);
  1124.           var reg1 uintD* ptr = &TheBignum(new)->data[2];
  1125.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1126.           *ptr-- = (uintD)wert;
  1127.           #if (2*intDsize>=64)
  1128.             *ptr = 0;
  1129.           #else
  1130.             wert = wert >> intDsize; *ptr = (uintD)wert;
  1131.           #endif
  1132.           return new;
  1133.         }
  1134.       #endif
  1135.       #if (bn_minlength <= 4) && (UQ_maxlength >= 4)
  1136.       if ((4*intDsize-1 < 64)
  1137.           ? (wert <= (uint64)(bitc(4*intDsize-1)-1))
  1138.           : TRUE
  1139.          )
  1140.         # Bignum mit 4 Digits
  1141.         { var reg2 object new = allocate_bignum(4,0);
  1142.           var reg1 uintD* ptr = &TheBignum(new)->data[3];
  1143.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1144.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1145.           *ptr-- = (uintD)wert;
  1146.           #if (3*intDsize>=64)
  1147.             *ptr = 0;
  1148.           #else
  1149.             wert = wert >> intDsize; *ptr = (uintD)wert;
  1150.           #endif
  1151.           return new;
  1152.         }
  1153.       #endif
  1154.       #if (bn_minlength <= 5) && (UQ_maxlength >= 5)
  1155.       if ((5*intDsize-1 < 64)
  1156.           ? (wert <= (uint64)(bitc(5*intDsize-1)-1))
  1157.           : TRUE
  1158.          )
  1159.         # Bignum mit 5 Digits
  1160.         { var reg2 object new = allocate_bignum(5,0);
  1161.           var reg1 uintD* ptr = &TheBignum(new)->data[4];
  1162.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1163.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1164.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1165.           *ptr-- = (uintD)wert;
  1166.           #if (4*intDsize>=64)
  1167.             *ptr = 0;
  1168.           #else
  1169.             wert = wert >> intDsize; *ptr = (uintD)wert;
  1170.           #endif
  1171.           return new;
  1172.         }
  1173.       #endif
  1174.       #if (bn_minlength <= 6) && (UQ_maxlength >= 6)
  1175.       if ((6*intDsize-1 < 64)
  1176.           ? (wert <= (uint64)(bitc(6*intDsize-1)-1))
  1177.           : TRUE
  1178.          )
  1179.         # Bignum mit 6 Digits
  1180.         { var reg2 object new = allocate_bignum(6,0);
  1181.           var reg1 uintD* ptr = &TheBignum(new)->data[5];
  1182.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1183.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1184.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1185.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1186.           *ptr-- = (uintD)wert;
  1187.           #if (5*intDsize>=64)
  1188.             *ptr = 0;
  1189.           #else
  1190.             wert = wert >> intDsize; *ptr = (uintD)wert;
  1191.           #endif
  1192.           return new;
  1193.         }
  1194.       #endif
  1195.       #if (bn_minlength <= 7) && (UQ_maxlength >= 7)
  1196.       if ((7*intDsize-1 < 64)
  1197.           ? (wert <= (uint64)(bitc(7*intDsize-1)-1))
  1198.           : TRUE
  1199.          )
  1200.         # Bignum mit 7 Digits
  1201.         { var reg2 object new = allocate_bignum(7,0);
  1202.           var reg1 uintD* ptr = &TheBignum(new)->data[6];
  1203.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1204.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1205.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1206.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1207.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1208.           *ptr-- = (uintD)wert;
  1209.           #if (6*intDsize>=64)
  1210.             *ptr = 0;
  1211.           #else
  1212.             wert = wert >> intDsize; *ptr = (uintD)wert;
  1213.           #endif
  1214.           return new;
  1215.         }
  1216.       #endif
  1217.       #if (bn_minlength <= 8) && (UQ_maxlength >= 8)
  1218.       if ((8*intDsize-1 < 64)
  1219.           ? (wert <= (uint64)(bitc(8*intDsize-1)-1))
  1220.           : TRUE
  1221.          )
  1222.         # Bignum mit 8 Digits
  1223.         { var reg2 object new = allocate_bignum(8,0);
  1224.           var reg1 uintD* ptr = &TheBignum(new)->data[7];
  1225.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1226.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1227.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1228.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1229.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1230.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1231.           *ptr-- = (uintD)wert;
  1232.           #if (7*intDsize>=64)
  1233.             *ptr = 0;
  1234.           #else
  1235.             wert = wert >> intDsize; *ptr = (uintD)wert;
  1236.           #endif
  1237.           return new;
  1238.         }
  1239.       #endif
  1240.       #if (bn_minlength <= 9) && (UQ_maxlength >= 9)
  1241.       if (TRUE)
  1242.         # Bignum mit 9 Digits
  1243.         { var reg2 object new = allocate_bignum(9,0);
  1244.           var reg1 uintD* ptr = &TheBignum(new)->data[8];
  1245.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1246.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1247.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1248.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1249.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1250.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1251.           *ptr-- = (uintD)wert; wert = wert >> intDsize;
  1252.           *ptr-- = (uintD)wert;
  1253.           #if (8*intDsize>=64)
  1254.             *ptr = 0;
  1255.           #else
  1256.             wert = wert >> intDsize; *ptr = (uintD)wert;
  1257.           #endif
  1258.           return new;
  1259.         }
  1260.       #endif
  1261.     }
  1262. #endif
  1263.  
  1264. # Liefert die Differenz x-y zweier Unsigned Longwords x,y als Integer.
  1265. # UL_UL_minus_I(x,y)
  1266.   local object UL_UL_minus_I (object x, object y);
  1267.   #ifdef intQsize
  1268.     #define UL_UL_minus_I(x,y)  Q_to_I((sintQ)(uintQ)(x)-(sintQ)(uintQ)(y))
  1269.   #else
  1270.     #define UL_UL_minus_I(x,y)  L2_to_I( ((x)<(y) ? -1L : 0), (x)-(y) )
  1271.   #endif
  1272.  
  1273. # Umwandlungsroutinen Digit sequence --> Integer:
  1274.  
  1275. # Normalized Digit sequence to Integer
  1276. # NDS_to_I(MSDptr,len)
  1277. # Digit Sequence MSDptr/len/.. in Integer umwandeln.
  1278. # kann GC auslösen
  1279.   local object NDS_to_I (uintD* MSDptr, uintC len);
  1280.   local object NDS_to_I(MSDptr,len)
  1281.     var reg2 uintD* MSDptr;
  1282.     var reg3 uintC len;
  1283.     { # Mehr als bn_minlength Digits -> Bignum.
  1284.       # Weniger als bn_minlength Digits -> Fixnum.
  1285.       # Genau bn_minlength Digits -> Bignum oder Fixnum.
  1286.       if (len < bn_minlength)
  1287.         { # 0..bn_minlength-1 Digits, paßt in ein Fixnum:
  1288.           if (bn_minlength>1 ? (len==0) : TRUE)
  1289.             # 0 Digits
  1290.             { return Fixnum_0; }
  1291.          {
  1292.           #ifndef intQsize
  1293.           var reg1 sint32 wert;
  1294.           if (bn_minlength>2 ? (len==1) : TRUE)
  1295.             # 1 Digit
  1296.             len_1:
  1297.             { wert = get_sint1D_Dptr(MSDptr); }
  1298.           elif (bn_minlength>3 ? (len==2) : TRUE)
  1299.             # 2 Digits
  1300.             len_2:
  1301.             { wert = get_sint2D_Dptr(MSDptr); }
  1302.           elif (bn_minlength>4 ? (len==3) : TRUE)
  1303.             # 3 Digits
  1304.             len_3:
  1305.             { wert = get_sint3D_Dptr(MSDptr); }
  1306.           elif (TRUE)
  1307.             # 4 Digits
  1308.             len_4:
  1309.             { wert = get_sint4D_Dptr(MSDptr); }
  1310.           elif (FALSE)
  1311.             # 5 Digits
  1312.             len_5:
  1313.             { wert = get_sint4D_Dptr(MSDptr); }
  1314.           #else # defined(intQsize) && (intDsize==32)
  1315.           var reg1 sint64 wert;
  1316.           if (TRUE)
  1317.             # 1 Digit
  1318.             len_1:
  1319.             { wert = (sint64)(sintD)MSDptr[0]; }
  1320.           elif (TRUE)
  1321.             # 2 Digits
  1322.             len_2:
  1323.             { wert = ((sint64)(sintD)MSDptr[0] << intDsize) | (uint64)(uintD)MSDptr[1]; }
  1324.           #endif
  1325.           return
  1326.             #if (oint_data_shift <= vorz_bit_o) && ((oint_data_len+1 <= intLsize) || defined(intQsize))
  1327.             as_object((( (soint)wert
  1328.                          & (FN_value_vz_mask>>oint_data_shift) # Unnötiges wegmaskieren
  1329.                        ) << oint_data_shift
  1330.                       )
  1331.                       | ((oint)fixnum_type<<oint_type_shift) # dafür Typinfo rein
  1332.                      )
  1333.             #else # Falls (oint_data_shift > vorz_bit_o)
  1334.                   # oder falls das Vorzeichenbit nicht in wert steckt
  1335.             as_object((( (soint)wert << oint_data_shift )
  1336.                        & FN_value_mask # Unnötiges wegmaskieren
  1337.                       )
  1338.                       | ((soint)(sint32)sign_of_sintD(MSDptr[0]) & wbit(vorz_bit_o))
  1339.                       | ((oint)fixnum_type<<oint_type_shift) # dafür Typinfo rein
  1340.                      )
  1341.             #endif
  1342.             ;
  1343.         }}
  1344.       if (len == bn_minlength)
  1345.         # bn_minlength Digits, also (incl. Vorzeichen) zwischen
  1346.         # (bn_minlength-1)*intDsize+1 und bn_minlength*intDsize Bits.
  1347.         # Höchstens oint_data_len+1 Bits -> paßt in ein Fixnum:
  1348.         { if (  (MSDptr[0] <= (uintD)(bit(oint_data_len-(bn_minlength-1)*intDsize)-1)) # Fixnum >=0 ?
  1349.               ||(MSDptr[0] >= (uintD)(-bit(oint_data_len-(bn_minlength-1)*intDsize))) # Fixnum <0 ?
  1350.              )
  1351.             #if (bn_minlength==1)
  1352.             goto len_1;
  1353.             #endif
  1354.             #if (bn_minlength==2)
  1355.             goto len_2;
  1356.             #endif
  1357.             #if (bn_minlength==3)
  1358.             goto len_3;
  1359.             #endif
  1360.             #if (bn_minlength==4)
  1361.             goto len_4;
  1362.             #endif
  1363.             #if (bn_minlength==5)
  1364.             goto len_5;
  1365.             #endif
  1366.         }
  1367.       # mindestens bn_minlength Digits, mache ein Bignum
  1368.       { var reg4 object new = allocate_bignum(len,sign_of_sintD(MSDptr[0]));
  1369.         # neues Bignum mit dem Inhalt der NDS füllen:
  1370.         copy_loop_up(MSDptr,&TheBignum(new)->data[0],len);
  1371.         return new;
  1372.     } }
  1373.  
  1374. # Bignum-Überlauf melden:
  1375.   nonreturning_function(local, BN_ueberlauf, (void));
  1376.   local void BN_ueberlauf()
  1377.     { 
  1378.       //: DEUTSCH "Überlauf von Bignums"
  1379.       //: ENGLISH "bignum overflow"
  1380.       //: FRANCAIS "Dépassage de capacité des entiers BIGNUM"
  1381.       fehler(error, GETTEXT("bignum overflow"));
  1382.     }
  1383.  
  1384. # Normalized Unsigned Digit Sequence to Integer
  1385. # NUDS_to_I(MSDptr,len)
  1386. # Normalized UDS MSDptr/len/.. in Integer >=0 umwandeln.
  1387. # Unterhalb von MSDptr muß 1 Digit Platz sein.
  1388. # kann GC auslösen
  1389.   local object NUDS_to_I (uintD* MSDptr, uintC len);
  1390.   local object NUDS_to_I(MSDptr,len)
  1391.     var reg1 uintD* MSDptr;
  1392.     var reg2 uintC len;
  1393.     { if ((!(len==0)) && ((sintD)MSDptr[0] < 0))
  1394.         # Falls die Länge >0 und das Most significant Bit = 1 sind,
  1395.         # die Digit Sequence um ein Nulldigit erweitern:
  1396.         { *--MSDptr = 0;
  1397.           len++;
  1398.           if (uintCoverflow(len)) { BN_ueberlauf(); } # Überlauf der Länge?
  1399.         }
  1400.       return NDS_to_I(MSDptr,len);
  1401.     }
  1402.  
  1403. # Unsigned Digit Sequence to Integer
  1404. # UDS_to_I(MSDptr,len)
  1405. # UDS MSDptr/len/.. in Integer >=0 umwandeln.
  1406. # Unterhalb von MSDptr muß 1 Digit Platz sein.
  1407. # kann GC auslösen
  1408.   local object UDS_to_I (uintD* MSDptr, uintC len);
  1409.   local object UDS_to_I(MSDptr,len)
  1410.     var reg1 uintD* MSDptr;
  1411.     var reg2 uintC len;
  1412.     { while ( (!(len==0)) && (MSDptr[0]==0) ) # solange len>0 und MSD = 0,
  1413.         { MSDptr++; len--; } # Nulldigit streichen
  1414.       # Dann wie bei NUDS_to_I :
  1415.       if ((!(len==0)) && ((sintD)MSDptr[0] < 0))
  1416.         # Falls die Länge >0 und das Most significant Bit = 1 sind,
  1417.         # die Digit Sequence um ein Nulldigit erweitern:
  1418.         { *--MSDptr = 0;
  1419.           len++;
  1420.           if (uintCoverflow(len)) { BN_ueberlauf(); } # Überlauf der Länge?
  1421.         }
  1422.       return NDS_to_I(MSDptr,len);
  1423.     }
  1424.  
  1425. # Digit Sequence to Integer
  1426. # DS_to_I(MSDptr,len)
  1427. # DS MSDptr/len/.. in Integer umwandeln.
  1428. # kann GC auslösen
  1429.   local object DS_to_I (uintD* MSDptr, uintC len);
  1430.   local object DS_to_I(MSDptr,len)
  1431.     var reg1 uintD* MSDptr;
  1432.     var reg3 uintC len;
  1433.     { # erst normalisieren.
  1434.       # Dabei evtl. MSDptr erhöhen und len erniedrigen:
  1435.       if (!(len==0)) # leere DS ist normalisiert
  1436.         { var reg2 uintC count = len-1;
  1437.           if ((sintD)MSDptr[0] >= 0)
  1438.             # Zahl >= 0
  1439.             { # versuche maximal len-1 führende Nullen-Digits zu streichen:
  1440.               while (!(count==0) && (MSDptr[0]==0) && ((sintD)MSDptr[1]>=0))
  1441.                 { MSDptr++; len--; count--; } # Nulldigit streichen
  1442.             }
  1443.             else
  1444.             # Zahl < 0
  1445.             # versuche maximal len-1 führende Einsen-Digits zu streichen:
  1446.             { while (!(count==0) && ((sintD)MSDptr[0]==-1) && ((sintD)MSDptr[1]<0))
  1447.                 { MSDptr++; len--; count--; } # Einsen-digit streichen
  1448.         }   }
  1449.       # Eventuell ist jetzt noch bei der DS 0 ausnahmsweise len=1,
  1450.       # aber NDS_to_I wird auch damit fertig.
  1451.       return NDS_to_I(MSDptr,len);
  1452.     }
  1453.  
  1454. # Umwandlungsroutinen Integer --> Digit sequence:
  1455.  
  1456. # Unterteilung eines Fixnums in Digits:
  1457. # intDsize=8 -> MSD=LSD3,LSD2,LSD1,LSD0, sollte FN_maxlength=4 sein.
  1458. # intDsize=16 -> MSD=LSD1,LSD0, sollte FN_maxlength=2 sein.
  1459. # intDsize=32 -> MSD=LSD0, sollte FN_maxlength=1 sein.
  1460. # WIDE -> ebenso, nur ist FN_maxlength noch eins größer.
  1461.  
  1462. #if FN_maxlength>1
  1463.   #define FN_LSD0(obj)  ((uintD)(as_oint(obj)>>oint_data_shift))
  1464. #elif FN_maxlength==1
  1465.   #define FN_LSD0  FN_MSD
  1466. #endif
  1467. #if FN_maxlength>2
  1468.   #define FN_LSD1(obj)  ((uintD)(as_oint(obj)>>(oint_data_shift+intDsize)))
  1469. #elif FN_maxlength==2
  1470.   #define FN_LSD1  FN_MSD
  1471. #else # FN_maxlength<2
  1472.   #define FN_LSD1(obj)  0; NOTREACHED  # sollte nicht aufgerufen werden!
  1473. #endif
  1474. #if FN_maxlength>3
  1475.   #define FN_LSD2(obj)  ((uintD)(as_oint(obj)>>(oint_data_shift+2*intDsize)))
  1476. #elif FN_maxlength==3
  1477.   #define FN_LSD2  FN_MSD
  1478. #else # FN_maxlength<3
  1479.   #define FN_LSD2(obj)  0; NOTREACHED  # sollte nicht aufgerufen werden!
  1480. #endif
  1481. #if FN_maxlength>4
  1482.   #define FN_LSD3(obj)  ((uintD)(as_oint(obj)>>(oint_data_shift+3*intDsize)))
  1483. #elif FN_maxlength==4
  1484.   #define FN_LSD3  FN_MSD
  1485. #else # FN_maxlength<4
  1486.   #define FN_LSD3(obj)  0; NOTREACHED  # sollte nicht aufgerufen werden!
  1487. #endif
  1488. #if FN_maxlength==5
  1489.   #define FN_LSD4  FN_MSD
  1490. #else # FN_maxlength<5
  1491.   #define FN_LSD4(obj)  0; NOTREACHED  # sollte nicht aufgerufen werden!
  1492. #endif
  1493. # FN_MSD: insgesamt muß um (FN_maxlength-1)*intDsize+oint_data_shift Bits
  1494. # nach rechts geshiftet werden.
  1495. #if defined(WIDE)
  1496.   #define FN_MSD(obj)  \
  1497.     ((uintD)( (sintD)(typecode(obj) << (intDsize-1-vorz_bit_t)) >> (intDsize-1)))
  1498. #elif (vorz_bit_o == oint_data_len+oint_data_shift) || ((oint_data_len==(FN_maxlength-1)*intDsize) && (vorz_bit_o >= intDsize-1))
  1499.   #if HAVE_DD
  1500.     #define FN_MSD(obj)  \
  1501.       ((sintD)((sintDD)(sintD)(as_oint(obj)>>(vorz_bit_o-(intDsize-1))) \
  1502.                >>(oint_data_shift-vorz_bit_o+FN_maxlength*intDsize-1)   \
  1503.       )       )
  1504.   #elif (vorz_bit_o < intDsize)
  1505.     #define FN_MSD(obj)  \
  1506.       (((sintD)as_oint(obj) << (intDsize-1-vorz_bit_o)) >> (FN_maxlength*intDsize-1-vorz_bit_o+oint_data_shift))
  1507.   #endif
  1508. #else
  1509.   # signD_of_sintD(x,k) liefert das Vorzeichen von x als sintD; die hinteren
  1510.   # k Bit sind irrelevant.
  1511.   #if HAVE_DD
  1512.     #define signD_of_sintD(x,k)  ((sintDD)(sintD)(x)>>intDsize)
  1513.   #else
  1514.     #define signD_of_sintD(x,k)  ((sintD)(x)>>(intDsize-1-(k)))
  1515.   #endif
  1516.   #if (vorz_bit_o >= intDsize)
  1517.     #define FN_MSD(obj)  \
  1518.       ( ((sintD)(as_oint(obj)>>(oint_data_shift+(FN_maxlength-1)*intDsize))&(bit(oint_data_len-(FN_maxlength-1)*intDsize)-1)) \
  1519.        |((sintD)signD_of_sintD(as_oint(obj)>>(vorz_bit_o-(intDsize-1)),oint_data_len-(FN_maxlength-1)*intDsize)&(-bit(oint_data_len-(FN_maxlength-1)*intDsize))) \
  1520.       )
  1521.   #else # (vorz_bit_o < intDsize)
  1522.     #define FN_MSD(obj)  \
  1523.       ( ((sintD)(as_oint(obj)>>(oint_data_shift+(FN_maxlength-1)*intDsize))&(bit(oint_data_len-(FN_maxlength-1)*intDsize)-1)) \
  1524.        |((sintD)signD_of_sintD(as_oint(obj)<<((intDsize-1)-vorz_bit_o),oint_data_len-(FN_maxlength-1)*intDsize)&(-bit(oint_data_len-(FN_maxlength-1)*intDsize))) \
  1525.       )
  1526.   #endif
  1527. #endif
  1528.  
  1529. # Fixnum to Normalized Digit sequence
  1530. # FN_to_NDS_nocopy(obj, MSDptr=,len=,LSDptr=);
  1531. # > obj: ein Fixnum
  1532. # < MSDptr/len/LSDptr: Normalized Digit sequence, im Maschinenstack
  1533.   #define FN_to_NDS_nocopy(obj,MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1534.     FN_to_NDS_(nocopy,obj,_EMA_ MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung)
  1535.   #if 0
  1536.     # Manche C-Compiler allozieren ihre Variablen auf dem Stack
  1537.     # überschneidungsfrei. Beispielsweise GCC 2.3.3 auf den meisten Systemen.
  1538.     # Coherent CC auf i386 und GCC 2.4.5 auf 680x0 allerdings nicht.
  1539.     # Wir gehen nun kein Risiko mehr ein.
  1540.     #define alloc_FNDS_nocopy(len,MSDptr_zuweisung,LSDptr_zuweisung)  \
  1541.       { var uintD UDS_from_FN_to_NDS[FN_maxlength]; \
  1542.         MSDptr_zuweisung &UDS_from_FN_to_NDS[0];    \
  1543.         LSDptr_zuweisung &UDS_from_FN_to_NDS[len];  \
  1544.       }
  1545.   #elif !defined(NEED_MALLOCA)
  1546.     # Alloziere einen Array, der bis Funktionsende existieren muß, mit alloca().
  1547.     #define alloc_FNDS_nocopy(len,MSDptr_zuweisung,LSDptr_zuweisung)  \
  1548.       { LSDptr_zuweisung                                                \
  1549.           (MSDptr_zuweisung (uintD*)alloca(FN_maxlength*sizeof(uintD))) \
  1550.           + (len);                                                      \
  1551.       }
  1552.   #else
  1553.     # Benutze malloca(), siehe SPVW.D. Hoffen wir, daß das Fehlen von
  1554.     # freea()-Aufrufen sich nicht zu stark bemerkbar macht.
  1555.     #define alloc_FNDS_nocopy(len,MSDptr_zuweisung,LSDptr_zuweisung)  \
  1556.       { LSDptr_zuweisung                                                 \
  1557.           (MSDptr_zuweisung (uintD*)malloca(FN_maxlength*sizeof(uintD))) \
  1558.           + (len);                                                       \
  1559.       }
  1560.   #endif
  1561.  
  1562. # Fixnum to Normalized Digit sequence
  1563. # FN_to_NDS(obj, MSDptr=,len=,LSDptr=);
  1564. # > obj: ein Fixnum
  1565. # < MSDptr/len/LSDptr: Normalized Digit sequence, darf modifiziert werden.
  1566. # Dabei wird num_stack erniedrigt.
  1567.   #define FN_to_NDS(obj,MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1568.     FN_to_NDS_(copy,obj,_EMA_ MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung)
  1569.   #define alloc_FNDS_copy  num_stack_need
  1570.  
  1571. # Fixnum to Normalized Digit sequence
  1572. # FN_to_NDS_1(obj, MSDptr=,len=,LSDptr=);
  1573. # > obj: ein Fixnum
  1574. # < MSDptr/len/LSDptr: Normalized Digit sequence, darf modifiziert werden.
  1575. # Unterhalb von MSDptr ist noch 1 Digit Platz.
  1576. # Dabei wird num_stack erniedrigt.
  1577.   #define FN_to_NDS_1(obj,MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1578.     FN_to_NDS_(copy_1,obj,_EMA_ MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung)
  1579.   #define alloc_FNDS_copy_1  num_stack_need_1
  1580.  
  1581.   #define FN_MSD1_mask  # wird nur bei FN_maxlength >= 2 gebraucht, d.h. intDsize-1 < oint_data_len \
  1582.     (FN_value_vz_mask & ~((oint)(bitc(intDsize-1)-1)<<oint_data_shift))
  1583.   #define FN_MSD2_mask  # wird nur bei FN_maxlength >= 3 gebraucht, d.h. 2*intDsize-1 < oint_data_len \
  1584.     (FN_value_vz_mask & ~((oint)(bitc(2*intDsize-1)-1)<<oint_data_shift))
  1585.   #define FN_MSD3_mask  # wird nur bei FN_maxlength >= 4 gebraucht, d.h. 3*intDsize-1 < oint_data_len \
  1586.     (FN_value_vz_mask & ~((oint)(bitc(3*intDsize-1)-1)<<oint_data_shift))
  1587.   #define FN_MSD4_mask  # wird nur bei FN_maxlength >= 5 gebraucht, d.h. 4*intDsize-1 < oint_data_len \
  1588.     (FN_value_vz_mask & ~((oint)(bitc(4*intDsize-1)-1)<<oint_data_shift))
  1589.   #define FN_to_NDS_(option, obj, MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1590.     { var reg1 oint fix_from_FN_to_NDS = as_oint(obj);                                              \
  1591.       var reg3 uintC len_from_FN_to_NDS;                                                            \
  1592.       var reg2 uintD* ptr_from_FN_to_NDS;                                                           \
  1593.       # Länge der NDS bestimmen:                                                                    \
  1594.       if (eq(as_object(fix_from_FN_to_NDS),Fixnum_0)) # mindestens 1 Digit nötig?                   \
  1595.         { len_from_FN_to_NDS=0; }                                                                   \
  1596.         else                                                                                        \
  1597.         { var reg3 oint testMSD; # vordere Bits von fix_from_FN_to_NDS                              \
  1598.           if ((FN_maxlength<=1) ||                                                                  \
  1599.               (((testMSD = fix_from_FN_to_NDS & FN_MSD1_mask) == 0) || (testMSD == FN_MSD1_mask))   \
  1600.              )                                                                                      \
  1601.             { len_from_FN_to_NDS=1; } # nur ein Digit abzulegen                                     \
  1602.           elif ((FN_maxlength<=2) ||                                                                \
  1603.                 (((testMSD = fix_from_FN_to_NDS & FN_MSD2_mask) == 0) || (testMSD == FN_MSD2_mask)) \
  1604.                )                                                                                    \
  1605.             { len_from_FN_to_NDS=2; } # zwei Digits abzulegen                                       \
  1606.           elif ((FN_maxlength<=3) ||                                                                \
  1607.                 (((testMSD = fix_from_FN_to_NDS & FN_MSD3_mask) == 0) || (testMSD == FN_MSD3_mask)) \
  1608.                )                                                                                    \
  1609.             { len_from_FN_to_NDS=3; } # drei Digits abzulegen                                       \
  1610.           elif ((FN_maxlength<=4) ||                                                                \
  1611.                 (((testMSD = fix_from_FN_to_NDS & FN_MSD4_mask) == 0) || (testMSD == FN_MSD4_mask)) \
  1612.                )                                                                                    \
  1613.             { len_from_FN_to_NDS=4; } # vier Digits abzulegen                                       \
  1614.           else                                                                                      \
  1615.             { len_from_FN_to_NDS=5; } # fünf Digits abzulegen                                       \
  1616.         }                                                                                           \
  1617.       len_zuweisung len_from_FN_to_NDS;                                                             \
  1618.       # Platz belegen:                                                                              \
  1619.       CONCAT(alloc_FNDS_,option)                                                                    \
  1620.         (len_from_FN_to_NDS, MSDptr_zuweisung ptr_from_FN_to_NDS =,_EMA_ LSDptr_zuweisung);         \
  1621.       # Platz füllen:                                                                               \
  1622.       if (len_from_FN_to_NDS > 0)                                                                   \
  1623.         { if ((FN_maxlength>1) && (len_from_FN_to_NDS > 1))                                         \
  1624.             { if ((FN_maxlength>2) && (len_from_FN_to_NDS > 2))                                     \
  1625.                 { if ((FN_maxlength>3) && (len_from_FN_to_NDS > 3))                                 \
  1626.                     { if ((FN_maxlength>4) && (len_from_FN_to_NDS > 4))                             \
  1627.                          # fünf Digits abzulegen:                                                   \
  1628.                          { *ptr_from_FN_to_NDS++ = FN_LSD4(as_object(fix_from_FN_to_NDS)); }        \
  1629.                       # noch vier Digits abzulegen:                                                 \
  1630.                       *ptr_from_FN_to_NDS++ = FN_LSD3(as_object(fix_from_FN_to_NDS));               \
  1631.                     }                                                                               \
  1632.                   # noch drei Digits abzulegen:                                                     \
  1633.                   *ptr_from_FN_to_NDS++ = FN_LSD2(as_object(fix_from_FN_to_NDS));                   \
  1634.                 }                                                                                   \
  1635.               # noch zwei Digits abzulegen:                                                         \
  1636.               *ptr_from_FN_to_NDS++ = FN_LSD1(as_object(fix_from_FN_to_NDS));                       \
  1637.             }                                                                                       \
  1638.           # noch ein Digit abzulegen:                                                               \
  1639.           *ptr_from_FN_to_NDS = FN_LSD0(as_object(fix_from_FN_to_NDS));                             \
  1640.         }                                                                                           \
  1641.     }
  1642.  
  1643. # Bignum to Normalized Digit sequence, Kopieren unnötig
  1644. # BN_to_NDS_nocopy(obj, MSDptr=,len=,LSDptr=);
  1645. # > obj: ein Bignum
  1646. # < MSDptr/len/LSDptr: Normalized Digit sequence
  1647.   #define BN_to_NDS_nocopy(obj, MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1648.     { var reg1 Bignum bn_from_BN_to_NDS_nocopy = TheBignum(obj);    \
  1649.       unused (MSDptr_zuweisung &bn_from_BN_to_NDS_nocopy->data[0]); \
  1650.       LSDptr_zuweisung &bn_from_BN_to_NDS_nocopy->data[(uintP)(     \
  1651.         len_zuweisung bn_from_BN_to_NDS_nocopy->length )];          \
  1652.     }
  1653.  
  1654. # Bignum to Normalized Digit sequence
  1655. # BN_to_NDS(obj, MSDptr=,len=,LSDptr=);
  1656. # > obj: ein Bignum
  1657. # < MSDptr/len/LSDptr: Normalized Digit sequence, darf modifiziert werden.
  1658. # Dabei wird num_stack erniedrigt.
  1659.   #define BN_to_NDS(obj, MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1660.     { var reg3 object obj_from_BN_to_NDS = (obj);                          \
  1661.       var reg1 uintD* MSDptr_from_BN_to_NDS;                               \
  1662.       var reg2 uintC len_from_BN_to_NDS;                                   \
  1663.       len_zuweisung len_from_BN_to_NDS = TheBignum(obj_from_BN_to_NDS)->length; \
  1664.       num_stack_need(len_from_BN_to_NDS, MSDptr_zuweisung MSDptr_from_BN_to_NDS = ,_EMA_ LSDptr_zuweisung); \
  1665.       copy_loop_up(&TheBignum(obj_from_BN_to_NDS)->data[0],MSDptr_from_BN_to_NDS,len_from_BN_to_NDS); \
  1666.     }
  1667.  
  1668. # Bignum to Normalized Digit sequence
  1669. # BN_to_NDS_1(obj, MSDptr=,len=,LSDptr=);
  1670. # > obj: ein Bignum
  1671. # < MSDptr/len/LSDptr: Normalized Digit sequence, darf modifiziert werden.
  1672. # Unterhalb von MSDptr ist noch 1 Digit Platz.
  1673. # Dabei wird num_stack erniedrigt.
  1674.   #define BN_to_NDS_1(obj, MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1675.     { var reg3 object obj_from_BN_to_NDS = (obj);                          \
  1676.       var reg1 uintD* MSDptr_from_BN_to_NDS;                               \
  1677.       var reg2 uintC len_from_BN_to_NDS;                                   \
  1678.       len_zuweisung len_from_BN_to_NDS = TheBignum(obj_from_BN_to_NDS)->length; \
  1679.       num_stack_need_1(len_from_BN_to_NDS, MSDptr_zuweisung MSDptr_from_BN_to_NDS = ,_EMA_ LSDptr_zuweisung); \
  1680.       copy_loop_up(&TheBignum(obj_from_BN_to_NDS)->data[0],MSDptr_from_BN_to_NDS,len_from_BN_to_NDS); \
  1681.     }
  1682.  
  1683. # Integer to Normalized Digit sequence, Kopieren unnötig.
  1684. # I_to_NDS_nocopy(obj, MSDptr=,len=,LSDptr=);
  1685. # > obj: ein Integer
  1686. # < MSDptr/len/LSDptr: Normalized Digit sequence
  1687.   #define I_to_NDS_nocopy(obj, MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1688.     { var reg3 object obj_from_I_to_NDS_nocopy = (obj);                          \
  1689.       if (I_fixnump(obj_from_I_to_NDS_nocopy))                                   \
  1690.         { FN_to_NDS_nocopy(obj_from_I_to_NDS_nocopy,_EMA_ MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung); } \
  1691.         else                                                                     \
  1692.         { BN_to_NDS_nocopy(obj_from_I_to_NDS_nocopy,_EMA_ MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung); } \
  1693.     }
  1694.  
  1695. # Integer to Normalized Digit sequence
  1696. # I_to_NDS(obj, MSDptr=,len=,LSDptr=);
  1697. # > obj: ein Integer
  1698. # < MSDptr/len/LSDptr: Normalized Digit sequence, darf modifiziert werden.
  1699. # Dabei wird num_stack erniedrigt.
  1700.   #define I_to_NDS(obj, MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1701.     { var reg3 object obj_from_I_to_NDS = (obj);                          \
  1702.       if (I_fixnump(obj_from_I_to_NDS))                                   \
  1703.         { FN_to_NDS(obj_from_I_to_NDS,MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung); } \
  1704.         else                                                              \
  1705.         { BN_to_NDS(obj_from_I_to_NDS,MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung); } \
  1706.     }
  1707.  
  1708. # Integer to Normalized Digit sequence
  1709. # I_to_NDS_1(obj, MSDptr=,len=,LSDptr=);
  1710. # > obj: ein Integer
  1711. # < MSDptr/len/LSDptr: Normalized Digit sequence, darf modifiziert werden.
  1712. # Unterhalb von MSDptr ist noch 1 Digit Platz.
  1713. # Dabei wird num_stack erniedrigt.
  1714.   #define I_to_NDS_1(obj, MSDptr_zuweisung,len_zuweisung,LSDptr_zuweisung)  \
  1715.     { var reg3 object obj_from_I_to_NDS = (obj);                            \
  1716.       if (I_fixnump(obj_from_I_to_NDS))                                     \
  1717.         { FN_to_NDS_1(obj_from_I_to_NDS,_EMA_ MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung); } \
  1718.         else                                                                \
  1719.         { BN_to_NDS_1(obj_from_I_to_NDS,_EMA_ MSDptr_zuweisung,len_zuweisung,_EMA_ LSDptr_zuweisung); } \
  1720.     }
  1721.  
  1722. # Holt die nächsten pFN_maxlength Digits in ein uint32:
  1723. # _ptr ist vom Typ uintD*.
  1724.   #if (pFN_maxlength==1)
  1725.     #define pFN_maxlength_digits_at(_ptr)  \
  1726.       (uint32)(_ptr[0])
  1727.   #elif (pFN_maxlength==2) && (intDsize==16)
  1728.     #define pFN_maxlength_digits_at(_ptr)  \
  1729.       highlow32_at(_ptr)
  1730.   #elif (pFN_maxlength==2)
  1731.     #define pFN_maxlength_digits_at(_ptr)  \
  1732.       (((uint32)(_ptr[0])<<intDsize)|       \
  1733.         (uint32)(_ptr[1]))
  1734.   #elif (pFN_maxlength==3)
  1735.     #define pFN_maxlength_digits_at(_ptr)  \
  1736.       (((((uint32)(_ptr[0])<<intDsize)|     \
  1737.           (uint32)(_ptr[1]))<<intDsize)|    \
  1738.           (uint32)(_ptr[2]))
  1739.   #elif (pFN_maxlength==4)
  1740.     #define pFN_maxlength_digits_at(_ptr)  \
  1741.       (((((((uint32)(_ptr[0])<<intDsize)|   \
  1742.             (uint32)(_ptr[1]))<<intDsize)|  \
  1743.             (uint32)(_ptr[2]))<<intDsize)|  \
  1744.             (uint32)(_ptr[3]))
  1745.   #endif
  1746.  
  1747. # Schreibt ein uint32 in die nächsten pFN_maxlength Digits:
  1748. # _ptr ist vom Typ uintD*, _wert vom Typ uint32.
  1749.   #if (pFN_maxlength==1)
  1750.     #define set_pFN_maxlength_digits_at(_ptr,_wert)  \
  1751.       (_ptr[0] = (uintD)_wert)
  1752.   #elif (pFN_maxlength==2) && (intDsize==16)
  1753.     #define set_pFN_maxlength_digits_at(_ptr,_wert)  \
  1754.       set_highlow32_at(_ptr,_wert)
  1755.   #elif (pFN_maxlength==2)
  1756.     #define set_pFN_maxlength_digits_at(_ptr,_wert)  \
  1757.       (_ptr[0] = (uintD)(_wert>>intDsize), \
  1758.        _ptr[1] = (uintD)(_wert)            \
  1759.       )
  1760.   #elif (pFN_maxlength==3)
  1761.     #define set_pFN_maxlength_digits_at(_ptr,_wert)  \
  1762.       (_ptr[0] = (uintD)(_wert>>(2*intDsize)), \
  1763.        _ptr[1] = (uintD)(_wert>>intDsize),     \
  1764.        _ptr[2] = (uintD)(_wert)                \
  1765.       )
  1766.   #elif (pFN_maxlength==4)
  1767.     #define set_pFN_maxlength_digits_at(_ptr,_wert)  \
  1768.       (_ptr[0] = (uintD)(_wert>>(3*intDsize)), \
  1769.        _ptr[1] = (uintD)(_wert>>(2*intDsize)), \
  1770.        _ptr[2] = (uintD)(_wert>>intDsize),     \
  1771.        _ptr[3] = (uintD)(_wert)                \
  1772.       )
  1773.   #endif
  1774.  
  1775.