home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / aridecl.d < prev    next >
Encoding:
Text File  |  1996-04-15  |  19.1 KB  |  449 lines
  1. # Deklarationen zur Arithmetik
  2.  
  3. # Typenhierarchie:
  4. # Number (N) =
  5. #    Real (R) =
  6. #       Float (F) =
  7. #          Short float (SF)
  8. #          Single float (FF)
  9. #          Double float (DF)
  10. #          Long float (LF)
  11. #       Rational (RA) =
  12. #          Integer (I) =
  13. #             Fixnum (FN)
  14. #             Bignum (BN)
  15. #          Ratio (RT)
  16. #    Complex (C)
  17.  
  18. # Anmerkungen:
  19. # - Complex dürfen aus zwei Real-Komponenten bestehen, die von verschiedenem
  20. #   Typ sind. Falls der Imaginärteil EQ zu 0 ist, wird ein Real draus gemacht.
  21. #   (Vgl. CLTL S. 195)
  22. #   Vorteil: Dann liefert (let ((x (sqrt -9.0))) (* x x))
  23. #     (statt x = #C(0.0 3.0)  -> Wert #C(-9.0 0.0) )
  24. #     x = #C(0 3.0)  -> Wert #C(-9.0 0) = -9.0
  25. # - Coercionen bei Operationen, wo verschiedene Typen auftreten:
  26. #     Rational -> Long-float -> Double-float -> Single-float -> Short-float
  27. #     (abweichend von CLTL S. 195)
  28. #     Grund: mathematisch gesehen, ist
  29. #            (1.0 +- 1e-8) + (1.0 +- 1e-16) = (2.0 +- 1e-8),
  30. #            also ist (+ 1.0s0 1.0d0) ==> 2.0s0 gerechtfertigt.
  31. #     Kurz: Nicht vorhandene Genauigkeit (accuracy) soll nicht (durch precision)
  32. #           vorgetäuscht werden.
  33. # - Bei Single und Double Float halte ich mich an den IEEE-Standard (1981),
  34. #     allerdings ohne solche Features wie +0,-0, +inf,-inf, gradual underflow,
  35. #     NAN, ...,  da COMMON LISP für sie sowieso keine Verwendung hat.
  36. # - Die Genauigkeit der Long Floats wird durch die Place (LONG-FLOAT-DIGITS)
  37. #   gegeben.
  38.  
  39.  
  40. # Datenstrukturen:
  41.  
  42. # Fixnum (FN) : 1 Langwort, direkt:
  43. #             Bits 30..24: Typinfo und Vorzeichen.
  44. #             Bits 23..0: Wert (mit dem Vorzeichen zusammen eine
  45. #                               Zweierkomplementdarstellung)
  46. # Maske für den Wert:
  47.   #define FN_value_mask  ((oint)(wbitm(oint_data_len+oint_data_shift)-wbit(oint_data_shift)))
  48. # Maske für Wert und Vorzeichen:
  49.   #define FN_value_vz_mask  (FN_value_mask|wbit(vorz_bit_o))
  50. # Typinfo für FN >=0:  fixnum_type
  51. # Typinfo für FN <0:
  52.   #define fixnum_vz_type  (fixnum_type|bit(vorz_bit_t))
  53. # (defconstant most-positive-fixnum (- (expt 2 oint_data_len) 1))
  54. # (defconstant most-negative-fixnum (- (expt 2 oint_data_len)))
  55. # Fixnum Null:
  56. # #define Fixnum_0  fixnum(0)
  57. # Fixnum Eins:
  58. # #define Fixnum_1  fixnum(1)
  59. # Fixnum Minus eins:
  60. # #define Fixnum_minus1  type_data_object(fixnum_vz_type,FN_value_mask>>oint_data_shift)
  61. # most-positive-fixnum:
  62.   #define Fixnum_mpos  type_data_object(fixnum_type,FN_value_mask>>oint_data_shift)
  63. # most-negative-fixnum:
  64.   #define Fixnum_mneg  type_data_object(fixnum_vz_type,0)
  65. # maximal nötige Länge einer Digit sequence zu einem Fixnum:
  66.   #define FN_maxlength  ceiling(oint_data_len+1,intDsize)
  67. # maximal nötige Länge (ohne Vorzeichen) einer Digit sequence zu einem Fixnum:
  68.   #define pFN_maxlength  ceiling(oint_data_len,intDsize)
  69. # Es gilt pFN_maxlength <= FN_maxlength <= bn_minlength.
  70.  
  71. # Langwort (L) - nur intern verwendet -
  72. # ein Langwort als signed integer, in Zweierkomplementdarstellung (sint32).
  73.  
  74. # Bignum (BN) : 1 Langwort, indirekt:
  75. #             Bits 30..24: Typinfo und Vorzeichen
  76. #             Bits 23..0: Pointer X
  77. #             X^.length = Länge n (uintC), >= bn_minlength
  78. #             X^.data = n Digits (als normalisierte Digit sequence)
  79.   #define bn_minlength  ceiling(oint_data_len+2,intDsize)
  80.   # denn Bignums mit n < ceiling((oint_data_len+2)/intDsize) Digits
  81.   # sind Integers mit höchstens intDsize*n < oint_data_len+2 Bits, also
  82.   # Integers mit höchstens oint_data_len+1 Bits (incl. Vorzeichen),
  83.   # und die passen in Fixnums. 1 <= bn_minlength <= 5.
  84.  
  85. # Ratio (RT) = faktisch ein record aus zwei Komponenten:
  86. #              NUM = Zähler (Integer), DEN = Nenner (Integer > 0)
  87. #              mit teilerfremdem Zähler und Nenner.
  88. # (ausführlich: Bits 30..24 = Typinfo und Vorzeichen
  89. #               Bits 23..0 = Pointer X
  90. #               X^.rt_num = NUM, X^.rt_den = DEN. )
  91.  
  92. # Rational (RA) = Integer oder Ratio.
  93.  
  94. # Bei allen Floating points:
  95. # Vorzeichen s, Exponent e, Mantisse mk-1,...,m0
  96. # bedeutet die Zahl (-1)^s * 2^(e-_EXP_MID) * [0 . 1 mk-1 ... m0]
  97. # e=0 bedeutet die Zahl 0, stets mit Vorzeichen s=0 (und Mantisse =0).
  98. # _exp_low und _exp_high sind Schranken (inklusive) für e.
  99. # Bitzahlen für   Vorzeichen s    Exponent e    Mantisse m (= k)
  100. # SF                   1              8             16
  101. # FF                   1              8             23
  102. # DF                   1              11            52
  103. # LF                   1              32            uintDsize*n >= 53
  104.  
  105. # Short float (SF)  : 1 Langwort, direkt:
  106. #             Bits 30..24: Typinfo und Vorzeichen s.
  107. #             Bits 23..16: Exponent e (8 Bits)
  108. #             Bits 15..0: Mantisse m (16 Bits)
  109. #             Die Zahl 0.0 wird durch s=0, e=0, m=0 repräsentiert.
  110.   #define SF_exp_len    8  # Anzahl der Bits des Exponenten
  111.   #define SF_mant_len  16  # Anzahl der Bits der Mantisse
  112.   #define SF_exp_low   1                    # minimaler Exponent
  113.   #define SF_exp_mid   bit(SF_exp_len-1)    # "Nullstellung" des Exponenten
  114.   #define SF_exp_high  (bit(SF_exp_len)-1)  # maximaler Exponent
  115.   #define SF_exp_shift  (SF_mant_len+SF_mant_shift) # unterstes Bit des Exponenten im oint
  116.   #define SF_mant_shift  oint_data_shift            # unterstes Bit der Mantisse im oint
  117. # Typinfo-Byte für SF >=0 :
  118.   #define SF_type     sfloat_type
  119. # Typinfo-Byte für SF <0, mit gesetztem Vorzeichen-Bit:
  120.   #define SF_vz_type  (sfloat_type|bit(vorz_bit_t))
  121. # Baut ein Float aus Vorzeichen (0 oder -1), Exponent und Mantisse zusammen:
  122.   #define make_SF(sign,exp,mant)  \
  123.     type_data_object(SF_type | (bit(vorz_bit_t) & (sign)), \
  124.       (((exp) & (bit(SF_exp_len)-1)) << SF_mant_len) | ((mant) & (bit(SF_mant_len)-1)) \
  125.       )
  126. # Short Float 0.0 :
  127.   #define SF_0  make_SF(0,0,0)
  128. # Short Float 1.0 :
  129.   #define SF_1  make_SF(0,SF_exp_mid+1,bit(SF_mant_len))
  130. # Short Float -1.0 :
  131.   #define SF_minus1  make_SF(-1,SF_exp_mid+1,bit(SF_mant_len))
  132.  
  133. # Single float (FF) : 1 Langwort, indirekt:
  134. #             Bits 30..24: Typinfo und Vorzeichen
  135. #             Bits 23..0: Pointer X
  136. #             X^.float_value = 1 Langwort:
  137. #                  Bit 31 = s, Bits 30..23 = e, Bits 22..0 = m.
  138. #             Die Zahl 0.0 wird durch s=0, e=0, m=0 repräsentiert.
  139.   #define FF_exp_len    8  # Anzahl der Bits des Exponenten
  140.   #define FF_mant_len  23  # Anzahl der Bits der Mantisse
  141.   #ifdef FAST_FLOAT # Müssen wir uns die Parameter vom Standard diktieren lassen?
  142.     #define FF_exp_low  1
  143.     #define FF_exp_mid  126  # Warum das die "Mitte" sein soll, ist mir unklar...
  144.     #define FF_exp_high 254  # Exponent 255 wird als NaN/Inf interpretiert!
  145.   #else # Ich wähle die Parameter liefer schön symmetrisch
  146.     #define FF_exp_low  1
  147.     #define FF_exp_mid  128
  148.     #define FF_exp_high 255
  149.   #endif
  150. # Typinfo-Byte für FF >=0 :
  151.   #define FF_type     ffloat_type
  152. # Typinfo-Byte für FF <0, mit gesetztem Vorzeichen-Bit:
  153.   #define FF_vz_type  (ffloat_type|bit(vorz_bit_t))
  154. #ifdef WIDE
  155. # Baut ein Float aus Vorzeichen (0 oder -1), Exponent und Mantisse zusammen:
  156.   #define make_FF(sign,exp,mant)  \
  157.     type_data_object(FF_type | (bit(vorz_bit_t) & (sign)), \
  158.       (sign) << (FF_exp_len+FF_mant_len)                   \
  159.       | (((exp) & (bit(FF_exp_len)-1)) << FF_mant_len)     \
  160.       | ((mant) & (bit(FF_mant_len)-1))                    \
  161.       )
  162. # Single Float 0.0 :
  163.   #define FF_0  make_FF(0,0,0)
  164. # Single Float 1.0 :
  165.   #define FF_1  make_FF(0,FF_exp_mid+1,bit(FF_mant_len))
  166. # Single Float -1.0 :
  167.   #define FF_minus1  make_FF(-1,FF_exp_mid+1,bit(FF_mant_len))
  168. #else
  169. # Single Float 0.0 :
  170.   #define FF_0  O(FF_zero)
  171. # Single Float 1.0 :
  172.   #define FF_1  O(FF_one)
  173. # Single Float -1.0 :
  174.   #define FF_minus1  O(FF_minusone)
  175. #endif
  176.  
  177. # Double float (DF) : 1 Langwort, indirekt:
  178. #             Bits 30..24: Typinfo und Vorzeichen
  179. #             Bits 23..0: Pointer X
  180. #             X^.float_value = 2 Langworte:
  181. #                  Bit 63 = s, Bits 62..52 = e, Bits 51..0 = m.
  182. #             Die Zahl 0.0 wird durch s=0, e=0, m=0 repräsentiert.
  183.   #define DF_exp_len   11  # Anzahl der Bits des Exponenten
  184.   #define DF_mant_len  52  # Anzahl der Bits der Mantisse
  185.   #ifdef FAST_DOUBLE # Müssen wir uns die Parameter vom Standard diktieren lassen?
  186.     #define DF_exp_low  1
  187.     #define DF_exp_mid  1022 # Warum das die "Mitte" sein soll, ist mir unklar...
  188.     #define DF_exp_high 2046 # Exponent 2047 wird als NaN/Inf interpretiert!
  189.   #else # Ich wähle die Parameter liefer schön symmetrisch
  190.     #define DF_exp_low  1
  191.     #define DF_exp_mid  1024
  192.     #define DF_exp_high 2047
  193.   #endif
  194. # Typinfo-Byte für DF >=0 :
  195.   #define DF_type     dfloat_type
  196. # Typinfo-Byte für DF <0, mit gesetztem Vorzeichen-Bit:
  197.   #define DF_vz_type  (dfloat_type|bit(vorz_bit_t))
  198. # Double Float 0.0 :
  199.   #define DF_0  O(DF_zero)
  200. # Double Float 1.0 :
  201.   #define DF_1  O(DF_one)
  202. # Double Float -1.0 :
  203.   #define DF_minus1  O(DF_minusone)
  204.  
  205. # Long float (LF) : 1 Langwort, indirekt:
  206. #             Bits 30..24: Typinfo und Vorzeichen
  207. #             Bits 23..0: Pointer X
  208. #             X^.len = n = Anzahl der dahinter kommenden Mantissenworte, n>=ceiling(53/intDsize)
  209. #             X^.expo = e (32 Bits)
  210. #             X^.data[0] ... X^.data[n-1] = intDsize*n Mantissenbits (MSD ... LSD)
  211. #             Die Zahl 0.0 wird durch e=0, Mantisse=0 repräsentiert.
  212. #             Bei e /= 0 ist das höchstwertige Bit =1.
  213. #             n>=ceiling(53/intDsize), damit ein LF nicht weniger Mantissenbits hat als ein DF.
  214.   #define LF_minlen  ceiling(53,intDsize)
  215.   #define LF_exp_low  1
  216.   #define LF_exp_mid  0x80000000UL
  217.   #define LF_exp_high 0xFFFFFFFFUL
  218. # Typinfo-Byte für LF >=0 :
  219.   #define LF_type     lfloat_type
  220. # Typinfo-Byte für LF <0, mit gesetztem Vorzeichen-Bit:
  221.   #define LF_vz_type  (lfloat_type|bit(vorz_bit_t))
  222.  
  223. # Byte (BYTE) : Record mit den Komponenten size und position:
  224. #             1 Langwort, indirekt:
  225. #             Bits 30..24: Typinfo
  226. #             Bits 23..0: Pointer X
  227. #             X^.byte_size = size, ein Fixnum >=0.
  228. #             X^.byte_position = position, ein Fixnum >=0.
  229. # Typtest mit bytep und if_bytep, Konstruktion mit allocate_byte().
  230.  
  231.  
  232. # NUM_STACK ist eine Art Zahlen-Stack-Pointer.
  233. # Verwendung:
  234. #   {SAVE_NUM_STACK
  235. #    ...
  236. #    num_stack_need(...);
  237. #    ...
  238. #    num_stack_need(...);
  239. #    RESTORE_NUM_STACK
  240. #    ...
  241. #   }
  242. # SAVE_NUM_STACK rettet den aktuellen Wert von NUM_STACK.
  243. # Dann darf beliebig oft mit num_stack_need Platz auf dem Zahlen-Stack
  244. # belegt werden.
  245. # Mit RESTORE_NUM_STACK wird NUM_STACK wieder auf den vorigen Wert gesetzt.
  246. # Auf dem belegten Platz darf noch bis zum Ende der aktuellen C-Funktion
  247. # gearbeitet werden (allerdings ohne eine andere C-Funktion aufzurufen, die
  248. # selbst wieder Platz auf dem Zahlen-Stack belegt). Mit Beendigung der
  249. # aktuellen C-Funktion gilt der Platz als wieder freigegeben.
  250. # In jeder C-Funktion sollte SAVE_NUM_STACK/RESTORE_NUM_STACK nur einmal
  251. # aufgerufen werden.
  252.  
  253. # num_stack_need(need, low_addr = , high_addr = );
  254. # belegt need Digits auf dem Zahlen-Stack und legt die untere Grenze des
  255. # allozierten Bereichs (den MSDptr) in low_addr und die obere Grenze (den
  256. # LSDptr) in high_addr ab. Jedes von beiden ist optional.
  257.  
  258. # num_stack_need_1(need, low_addr = , high_addr = );
  259. # wie num_stack_need, nur daß unterhalb von low_addr noch ein Digit Platz
  260. # zusätzlich belegt wird.
  261.  
  262. # Deklarationen für SPVW:
  263. #if !((defined(GNU) && !defined(RISCOS) && !defined(CONVEX)) || (defined(UNIX) && !defined(NO_ALLOCA) && !defined(SPARC)) || defined(WATCOM)) # siehe unten
  264.   #define HAVE_NUM_STACK
  265.   extern uintD*  NUM_STACK;
  266.   extern uintD*  NUM_STACK_bound;
  267.   extern uintD*  NUM_STACK_normal;
  268.   #define NUM_STACK_DOWN  # NUM_STACK wächst abwärts
  269. #endif
  270.  
  271. #ifdef LISPARIT
  272.  
  273. #if defined(GNU) && !defined(RISCOS) && !defined(CONVEX)
  274.   #if 0
  275.     # verkraftet dynamisch allozierte Arrays im Maschinenstack
  276.     #define SAVE_NUM_STACK
  277.     #define RESTORE_NUM_STACK  ;
  278.     #define num_stack_need(need,low_zuweisung,high_zuweisung)  \
  279.       {var reg1 uintL __need = (uintL)(need);                      \
  280.        var uintD __array [__need];                                 \
  281.        check_SP_notUNIX();                                         \
  282.        low_zuweisung &__array[0]; high_zuweisung &__array[__need]; \
  283.       }
  284.     #define num_stack_need_1(need,low_zuweisung,high_zuweisung)  \
  285.       {var reg1 uintL __need = (uintL)(need)+1;                    \
  286.        var uintD __array [__need];                                 \
  287.        check_SP_notUNIX();                                         \
  288.        low_zuweisung &__array[1]; high_zuweisung &__array[__need]; \
  289.       }
  290.     # Funktioniert aber nicht, da der bereitgestellte Speicherplatz
  291.     # sofort wieder freigegeben wird!
  292.   #else
  293.     # Fast identisch, nur daß der belegte Platz erst bei Beendigung
  294.     # der C-Funktion freigegeben wird:
  295.     #define SAVE_NUM_STACK
  296.     #define RESTORE_NUM_STACK  ;
  297.     #define num_stack_need(need,low_zuweisung,high_zuweisung)  \
  298.       {var reg1 uintL __need = (uintL)(need);                                        \
  299.        var reg1 uintD* __array = (uintD*)__builtin_alloca(__need*sizeof(uintD));     \
  300.        check_SP_notUNIX();                                                           \
  301.        unused (low_zuweisung &__array[0]); unused (high_zuweisung &__array[__need]); \
  302.       }
  303.     #define num_stack_need_1(need,low_zuweisung,high_zuweisung)  \
  304.       {var reg1 uintL __need = (uintL)(need)+1;                                      \
  305.        var reg1 uintD* __array = (uintD*)__builtin_alloca(__need*sizeof(uintD));     \
  306.        check_SP_notUNIX();                                                           \
  307.        unused (low_zuweisung &__array[1]); unused (high_zuweisung &__array[__need]); \
  308.       }
  309.   #endif
  310. #elif (defined(UNIX) && !defined(NO_ALLOCA) && !defined(SPARC)) || defined(WATCOM)
  311.   # Platz im Maschinenstack reservieren.
  312.   #define SAVE_NUM_STACK
  313.   #define RESTORE_NUM_STACK  ;
  314.   #define num_stack_need(need,low_zuweisung,high_zuweisung)  \
  315.     {var reg1 uintL __need = (uintL)(need);                          \
  316.      var reg1 uintD* __array = (uintD*)alloca(__need*sizeof(uintD)); \
  317.      low_zuweisung &__array[0]; high_zuweisung &__array[__need];     \
  318.     }
  319.   #define num_stack_need_1(need,low_zuweisung,high_zuweisung)  \
  320.     {var reg1 uintL __need = (uintL)(need)+1;                        \
  321.      var reg1 uintD* __array = (uintD*)alloca(__need*sizeof(uintD)); \
  322.      low_zuweisung &__array[1]; high_zuweisung &__array[__need];     \
  323.     }
  324. #else
  325.   # Verwende eine globale Variable als Zahlen-Stack-Pointer.
  326.   global uintD*  NUM_STACK;
  327.   global uintD*  NUM_STACK_bound;
  328.   # Dieser Zahlen-Stack-Pointer wird nur von den arithmetischen Funktionen
  329.   # benutzt und hat nach Beendigung einer solchen Funktion wieder denselben
  330.   # Wert wie bei Eintritt in diese Funktion.
  331.   # Arithmetische Funktionen können aber (z.B. durch die Tastaturabfrage
  332.   # bei der Garbage-Collection) rekursiv einen Driver und damit weitere
  333.   # arithmetische Funktionen aufrufen.
  334.   # Zurücksetzen von NUM_STACK bei Fehlerbehandlung: Beim nichtfortsetzenden
  335.   # Verlassen eines Drivers (und auch bei der Auflösung eines Driver-Frames)
  336.   # erhält NUM_STACK den Wert, den es im vorigen Driver hatte. Beim
  337.   # fortsetzenden Verlassen eines Drivers dagegen bleibt NUM_STACK unver-
  338.   # ändert auf dem Wert, den es bei Eintritt in diesen Driver hatte.
  339.   # (Dies funktioniert, da die Arithmetik-Funktionen keine Frames aufmachen,
  340.   # an die man unwinden könnte.)
  341.   global uintD*  NUM_STACK_normal;  # Wert von NUM_STACK im letzten Driver
  342.   #
  343.   #define SAVE_NUM_STACK  var reg10 uintD* old_num_stack = NUM_STACK;
  344.   #define RESTORE_NUM_STACK  NUM_STACK = old_num_stack;
  345.   #
  346.   # Fehlermeldung, wenn zuwenig Platz für num_stack:
  347.     nonreturning_function(local, arith_ueberlauf, (void));
  348.     local void arith_ueberlauf()
  349.       { 
  350.          //: DEUTSCH "Stacküberlauf beim Hantieren mit langen Zahlen"
  351.          //: ENGLISH "stack overflow during bignum arithmetic"
  352.          //: FRANCAIS "Débordement de pile lors d'opérations avec de longs nombres"
  353.         fehler(storage_condition,GETTEXT( "stack overflow during bignum arithmetic"));
  354.       }
  355.   #
  356.   # Error liefern, wenn eine Adresse NUM_STACK_bound unterschritten hat:
  357.   # compare_NUM_STACK_bound(addr);
  358.     #if 1
  359.       #ifdef NUM_STACK_DOWN
  360.         #define compare_NUM_STACK_bound(addr)  \
  361.           ( (aint)(addr) < (aint)NUM_STACK_bound ? (arith_ueberlauf(),0) : 0 )
  362.       #endif
  363.       #ifdef NUM_STACK_UP
  364.         #define compare_NUM_STACK_bound(addr)  \
  365.           ( (aint)(addr) > (aint)NUM_STACK_bound ? (arith_ueberlauf(),0) : 0 )
  366.       #endif
  367.     #else # Wenn nichts zu überprüfen ist: trotzdem 'addr' auswerten!
  368.       #define compare_NUM_STACK_bound(addr)  (addr)
  369.     #endif
  370.   #
  371.   # num_stack_need(need, low_addr = , high_addr = );
  372.   # zieht von num_stack need Digits ab, testet dabei auf Stack-Überlauf und
  373.   # liefert die untere Grenze des so allozierten Bereiches in low_addr
  374.   # und die obere Grenze in high_addr. Jedes von beiden ist optional.
  375.     #ifdef NUM_STACK_DOWN
  376.       #define num_stack_need(need,low_zuweisung,high_zuweisung)  \
  377.         (high_zuweisung NUM_STACK,                        \
  378.          NUM_STACK -= (aint)(need),                       \
  379.          compare_NUM_STACK_bound(low_zuweisung NUM_STACK) \
  380.         )
  381.       #define num_stack_need_1(need,low_zuweisung,high_zuweisung)  \
  382.         (high_zuweisung NUM_STACK,                                                           \
  383.          compare_NUM_STACK_bound(NUM_STACK = (low_zuweisung (NUM_STACK - (aint)(need))) - 1) \
  384.         )
  385.     #endif
  386.     #ifdef NUM_STACK_UP
  387.       #define num_stack_need(need,low_zuweisung,high_zuweisung)  \
  388.         (low_zuweisung NUM_STACK,                          \
  389.          NUM_STACK += (aint)(need),                        \
  390.          compare_NUM_STACK_bound(high_zuweisung NUM_STACK) \
  391.         )
  392.       #define num_stack_need_1(need,low_zuweisung,high_zuweisung)  \
  393.         (low_zuweisung NUM_STACK += 1,                     \
  394.          NUM_STACK += (aint)(need),                        \
  395.          compare_NUM_STACK_bound(high_zuweisung NUM_STACK) \
  396.         )
  397.     #endif
  398. #endif
  399.  
  400. #endif # LISPARIT
  401.  
  402.  
  403. # Liefert 2^n, n eine Constant expression.
  404. # Ergebnis dasselbe wie bit(n), jedoch undefiniert falls n<0 oder n>=32.
  405.   #define bitc(n)  (1UL << (((n) >= 0 && (n) < intLsize) ? (n) : 0))
  406.  
  407.  
  408. #ifdef LISPARIT
  409.  
  410. # Fehlermeldung wegen Division durch Null
  411.   nonreturning_function(local, divide_0, (void));
  412.   local void divide_0()
  413.     { 
  414.       //: DEUTSCH "Division durch Null"
  415.       //: ENGLISH "division by zero"
  416.       //: FRANCAIS "Division par zéro"
  417.       fehler(division_by_zero,GETTEXT("division by zero"));
  418.     }
  419.  
  420. # Fehlermeldung wegen Floating-Point-Überlauf
  421. # fehler_overflow();
  422.   nonreturning_function(local, fehler_overflow, (void));
  423.   local void fehler_overflow()
  424.     { 
  425.       //: DEUTSCH "Floating-Point Überlauf"
  426.       //: ENGLISH "floating point overflow"
  427.       //: FRANCAIS "Débordement de nombre à virgule flottante"
  428.       fehler(floating_point_overflow,GETTEXT("floating point overflow"));
  429.     }
  430.  
  431. # Fehlermeldung wegen Floating-Point-Unterlauf
  432. # fehler_underflow();
  433.   nonreturning_function(local, fehler_underflow, (void));
  434.   local void fehler_underflow()
  435.     { 
  436.       //: DEUTSCH "Floating-Point Unterlauf"
  437.       //: ENGLISH "floating point underflow"
  438.       //: FRANCAIS "Débordement vers zéro de nombre à virgule flottante"
  439.       fehler(floating_point_underflow,GETTEXT("floating point underflow"));
  440.     }
  441.  
  442. # Stellt fest, ob Floating-Point-Unterlauf erlaubt ist
  443. # underflow_allowed()
  444.   #define underflow_allowed()  \
  445.     (sym_nullp(S(inhibit_floating_point_underflow)))
  446.  
  447. #endif # LISPARIT
  448.  
  449.