home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / dev / lang / umbscheme / src / bignum.c < prev    next >
C/C++ Source or Header  |  1993-11-29  |  22KB  |  1,128 lines
  1. /* bignum.c -- UMB Scheme, implementation of bignum numbers. 
  2.  
  3. UMB Scheme Interpreter                  $Revision: 2.12 $
  4. Copyright (C) 1988, 1991 William R Campbell
  5.  
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. This program is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with this program; if not, write to the Free Software
  18. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. UMB Scheme was written by Bill Campbell with help from Karl Berry,
  21. Barbara Dixey, Ira Gerstein, Mary Glaser, Kathy Hargreaves, Bill McCabe,
  22. Long Nguyen, Susan Quina, Jeyashree Sivasubram, Bela Sohoni and Thang Quoc Tran.
  23.  
  24. For additional information about UMB Scheme, contact the author:
  25.  
  26.     Bill Campbell
  27.     Department of Mathematics and Computer Science
  28.     University of Massachusetts at Boston
  29.     Harbor Campus
  30.     Boston, MA 02125
  31.  
  32.     Telephone: 617-287-6449        Internet: bill@cs.umb.edu
  33.  
  34. */
  35.  
  36. #include "portable.h"
  37. #include "eval.h"
  38. #include "object.h"
  39. #include "architecture.h"
  40. #include "number.h"
  41. #include "fixnum.h"
  42. #include "bignum.h"
  43. #include "rational.h"
  44. #include "real.h"
  45. #include "complex.h"
  46. #include "steering.h"
  47. #include "io.h"
  48. #include <math.h>
  49. #include <errno.h>
  50.  
  51. #define Most_Significant_Digit(num) \
  52.             (Get_Number_Digit( (num) , Get_Number_Length(num) - 1 ))
  53.  
  54.  
  55. Private Short    Bignum_Compare();
  56. Private    void    Delete_Leading_Zeros();
  57. Public    void    Long_Division();
  58.  
  59.  
  60. /* REPRESENTATION */
  61.  
  62. #define MAX_DIGIT        (RADIX-1)
  63.  
  64. #define Low_16(long)        (((long) >= 0) ? (Short) ((long) % RADIX) \
  65.                           : (-(Short) (-(long) % RADIX)))
  66.  
  67. #define High_16(long)    (((long) >= 0) ? (Short) ((long) / RADIX) \
  68.                           : (-(Short) (-(long) / RADIX)))
  69.  
  70. #define Integer_Digit(n,i)    ((Integer) Get_Number_Digit(n,i))
  71.  
  72.  
  73. #define max(a,b) ((a) > (b) ? (a) : (b))
  74. #define min(a,b) ((a) < (b) ? (a) : (b))
  75.  
  76.  
  77. /* Predicates. */
  78.  
  79. Public Boolean Is_Bignum_Zero()
  80. {
  81.     return (Number_Sign(Top(1)) == 0);
  82. }
  83.  
  84.  
  85. Public Boolean Is_Bignum_Positive()
  86. {
  87.     return (Number_Sign(Top(1)) > 0);
  88. }
  89.  
  90.  
  91.  
  92. Public Boolean Is_Bignum_Negative()
  93. {
  94.     return (Number_Sign(Top(1)) < 0);
  95. }
  96.  
  97.  
  98.  
  99. Public Boolean Is_Bignum_Odd()
  100. {
  101.     return (! Is_Bignum_Even());
  102. }
  103.  
  104.  
  105.  
  106. Public Boolean Is_Bignum_Even()
  107. {
  108.     return ( (Get_Number_Digits(Top(1))[0] % 2) == 0);
  109. }
  110.  
  111.  
  112.  
  113. Public Boolean Is_Bignum_Exact()
  114. {
  115.     return( TRUE ); 
  116. }
  117.  
  118.  
  119.  
  120. Public Boolean Is_Bignum_Inexact()
  121. {
  122.     return( FALSE );
  123. }
  124.  
  125.  
  126.  
  127.  
  128. /* General comparison. */
  129.  
  130. Public Boolean Bignum_Equal()
  131. {
  132.     return Bignum_Compare() == 0;
  133. }
  134.  
  135.  
  136.  
  137. Public Boolean Bignum_Less_Than()
  138. {
  139.     return Bignum_Compare() < 0;
  140. }
  141.  
  142.  
  143.  
  144. Public Boolean Bignum_Greater_Than()
  145. {
  146.     return Bignum_Compare() > 0;
  147. }
  148.  
  149.  
  150.  
  151. Public Boolean Bignum_Less_Than_Or_Equal()
  152. {
  153.     return Bignum_Compare() <= 0;
  154. }
  155.  
  156.  
  157.  
  158. Public Boolean Bignum_Greater_Than_Or_Equal()
  159. {
  160.     return Bignum_Compare() >= 0;
  161. }
  162.  
  163.  
  164.  
  165. Private Short Bignum_Compare()
  166. {
  167.     Bignum_Subtract();
  168.     return Number_Sign( Value_Register );
  169. }
  170.  
  171.  
  172.  
  173.  
  174. /* BIGNUM ADDITION */
  175.  
  176. Public void Bignum_Add()
  177. {
  178.     Integer    size1 = Get_Number_Length( Top(1) );
  179.     Integer    size2 = Get_Number_Length( Top(2) );
  180.     Integer newsize;
  181.     Integer    accumulator;
  182.     Integer index;
  183.     Short    carry;
  184.  
  185.     Object    top1, top2;
  186.  
  187.     /* Compute number of digits in result */
  188.  
  189.     newsize = size1 > size2 ? size1+1 : size2+1;
  190.  
  191.     Make_Bignum_Number( newsize );
  192.     top1 = Top(1);
  193.     top2 = Top(2);
  194.  
  195.     carry = 0;
  196.     for ( index = 0; index < newsize; index++ )
  197.     {
  198.         accumulator = (Integer) carry +
  199.             (index < size1 ? Integer_Digit( top1 , index ) : 0) +
  200.             (index < size2 ? Integer_Digit( top2 , index ) : 0);
  201.         Get_Number_Digit(Value_Register, index) = Low_16( accumulator );
  202.         carry = High_16( accumulator );
  203.     }
  204.     Delete_Leading_Zeros( Value_Register );
  205. }
  206.  
  207. /* BIGNUM SUBTRACTION */
  208.  
  209.  
  210. Public void Bignum_Subtract()
  211. {
  212.     Integer    size1 = Get_Number_Length( Top(1) );
  213.     Integer    size2 = Get_Number_Length( Top(2) );
  214.     Integer newsize;
  215.     Integer    accumulator;
  216.     Integer index;
  217.     Short    carry;
  218.  
  219.     Object    top1, top2;
  220.  
  221.     /* Compute number of digits in result */
  222.  
  223.     newsize = size1 > size2 ? size1+1 : size2+1;
  224.  
  225.     Make_Bignum_Number( newsize );
  226.     top1 = Top(1);
  227.     top2 = Top(2);
  228.  
  229.     carry = 0;
  230.     for ( index = 0; index < newsize; index++ )
  231.     {
  232.         accumulator = (Integer) carry -
  233.             (index < size1 ? Integer_Digit( top1 , index ) : 0) +
  234.             (index < size2 ? Integer_Digit( top2 , index ) : 0);
  235.         Get_Number_Digit(Value_Register, index) = Low_16( accumulator );
  236.         carry = High_16( accumulator );
  237.     }
  238.     Delete_Leading_Zeros( Value_Register );
  239. }
  240.  
  241. /* BIGNUM MULTIPLICATION  */
  242.  
  243.  
  244. Public void Bignum_Multiply()
  245. {
  246.     Integer    size1 = Get_Number_Length( Top(1) );
  247.     Integer    size2 = Get_Number_Length( Top(2) );
  248.     Integer newsize;
  249.     Integer    accumulator;
  250.     Integer index1, index2;
  251.     Short    carry;
  252.  
  253.     Object    top1, top2;
  254.  
  255.     /* Compute number of digits in result */
  256.  
  257.     newsize = size1 + size2;
  258.     if ( abs( (Integer) Most_Significant_Digit(Top(1)) *
  259.         (Integer) Most_Significant_Digit(Top(2)) ) <= MAX_DIGIT )
  260.     {
  261.         newsize--;
  262.     }
  263.  
  264.     Make_Bignum_Number( newsize );
  265.     top1 = Top(1);
  266.     top2 = Top(2);
  267.  
  268.     for ( index1 = 0; index1 < size1; index1 ++ )
  269.     {
  270.         carry = 0;
  271.         for ( index2 = 0; index2 < size2; index2 ++ )
  272.         {
  273.             accumulator = (Integer) carry +
  274.                 Integer_Digit( top1 , index1 ) *
  275.                 Integer_Digit( top2 , index2 ) +
  276.                 Integer_Digit( Value_Register , index1+index2 );
  277.             Get_Number_Digit(Value_Register , index1+index2) =
  278.                 Low_16( accumulator );
  279.             carry = High_16( accumulator );
  280.         }
  281.         if ( index1 + index2 < newsize )
  282.         {
  283.             Get_Number_Digit(Value_Register, index1+index2) = carry;
  284.         }
  285.     }
  286.  
  287.     Delete_Leading_Zeros( Value_Register );
  288. }
  289.  
  290.  
  291. /* BIGNUM DIVISION. */
  292.       
  293. #define QUOTIENT        Top( 1 )
  294. #define DENOMINATOR     Top( 2 )
  295. #define NUMERATOR       Top( 3 )
  296.  
  297. Private Boolean Numerator_Less_Than_Denominator()
  298.  
  299. {
  300.     Boolean result;
  301.  
  302.                                         /* Stack: Q, D, N, d, n...   */
  303.         Push( Top(3) );                 /* Stack: N, Q, D, N, d, n...   */
  304.         Bignum_Abs();
  305.         Pop(1);                         /* Stack: Q, D, N, d, n...   */
  306.         Push(Value_Register);           /* Stack: |N|, Q, D, N, d, n...   */
  307.         Push( Top(3) );                 /* Stack: D, |N|, Q, D, N, d, n...   */
  308.     result = Bignum_Less_Than();     /* compare |numerator| < denominator */
  309.         Pop(2);                         /* Stack: Q, D, N, d, n...   */
  310.     return result;
  311. }
  312.  
  313. Private void Normalize ()
  314.         
  315.     
  316.         /* First justify remainder (numerator) if it's negative. Then
  317.     justify signs for quotient and remainder based on nsign, and
  318.     dsign. Leave quotient in Value_Register and remainder on top 
  319.     of stack.
  320.     */
  321.  
  322. {
  323.     Integer    dsign = Number_Sign( Top(4) );
  324.     Integer    nsign = Number_Sign( Top(5) );
  325.         
  326.     /* Justify values for quotient and remainder
  327.            if numerator < 0,  then 1: quotient has to be one unit less,
  328.                                    2: remainder += denominator
  329.         */
  330.  
  331.  
  332.         if (Number_Sign( Top(3) ) < 0)    /* Stack: Q, D, N, d, n...   */
  333.     {
  334.         Make_Small_Bignum( -1 );
  335.                 Push( Value_Register );   /* Stack: -1, Q, D, N, d, n...   */
  336.         Bignum_Add(); 
  337.                 Pop( 2 );                 /* Stack: D, N, d, n...   */
  338.                 Push( Value_Register );   /* Stack: Q-1, D, N, d, n...   */
  339.  
  340.  
  341.                 Push( Top(3) );           /* Stack: N, Q-1, D, N, d, n...   */
  342.                 Push( Top(3) );           /* Stack: D, N, Q-1, D, N, d, n... */
  343.         Bignum_Add(); 
  344.                 Pop( 2 );                 /* Stack: Q-1, D, N, d, n...   */
  345.                 Top( 3 ) = Value_Register; /* adjusted remainder(numerator) */
  346.     }
  347.  
  348.     /* now justify the signs for quotient and remainder */
  349.  
  350.     if ( nsign < 0 && dsign < 0) /* must reverse sign of remainder */
  351.         {
  352.                 Make_Small_Bignum( 0 );
  353.                 Push( Value_Register );   /* Stack: 0, Q, D, N, d, n...   */
  354.                 Push( Top(4) );           /* Stack: N, 0, Q, D, N, d, n... */
  355.         Bignum_Subtract();
  356.                 Pop( 2 );                 /* Stack: Q, D, N, d, n... */
  357.                 Top( 3 ) = Value_Register;
  358.     }
  359.     else if ( nsign > 0 && dsign < 0 ) /* must reverse sign of quotient */
  360.     {
  361.         Make_Small_Bignum( 0 );
  362.                 Push( Value_Register );   /* Stack: 0, Q, D, N, d, n... */
  363.                 Push( Top(2) );           /* Stack: Q, 0, Q, D, N, d, n... */
  364.         Bignum_Subtract();
  365.                 Pop(3);                   /* Stack: D, N, d, n... */
  366.                 Push( Value_Register) ;   /* Stack: Q, D, N, d, n... */
  367.     }
  368.     else if ( nsign < 0 && dsign > 0 ) /* reverse signs for both */
  369.     {
  370.         Make_Small_Bignum( 0 );
  371.                 Push( Value_Register );   /* Stack: 0, Q, D, N, d, n...   */
  372.                 Push( Top(4) );           /* Stack: N, 0, Q, D, N, d, n... */
  373.         Bignum_Subtract();
  374.                 Pop( 1 );                 /* Stack: 0, Q, D, N, d, n... */
  375.                 Top( 4 ) = Value_Register;
  376.  
  377.                 Push( Top(2) );           /* Stack: Q, 0, Q, D, N, d, n... */
  378.         Bignum_Subtract();
  379.                 Pop(3);                   /* Stack: D, N, d, n... */
  380.                 Push( Value_Register) ;   /* Stack: Q, D, N, d, n... */
  381.     }
  382.         Value_Register = Top( 1 );
  383.         Pop( 2 );
  384.  
  385. }
  386.  
  387.  
  388.  
  389. Public void Bignum_Divide()
  390. {
  391.     Make_Rational_Number();
  392. }
  393.  
  394.  
  395.  
  396. Public    void Long_Division()
  397.         /* Value_Register = Top(1) / Top(2)  */
  398.         /* Push( Top(1) % Top(2) )           */
  399.  
  400. {
  401.         Integer dsize = Get_Number_Length( Top(1) );
  402.     Integer    nsize = Get_Number_Length( Top(2) );
  403.     Integer    dsign = Number_Sign( Top(1) );
  404.     Integer    nsign = Number_Sign( Top(2) );
  405.         Integer accumulator, first_digit;
  406.         Short   index, start_index, first_denominator_digit, carry;
  407.  
  408.  
  409.     
  410.     Push( Copy_Object( Top(2), Bignum_Size(nsize))); /* copied numerator */
  411.     if ( nsign < 0 )  /* if numerator < 0, make it positive */    
  412.     {
  413.         Bignum_Abs(); 
  414.         Pop(1);
  415.         Push( Value_Register );
  416.     }
  417.  
  418.     Push( Copy_Object( Top(2), Bignum_Size(dsize)));/*copied denominator */
  419.     if ( dsign < 0 ) /* if denominator < 0, make it positive */
  420.     {
  421.         Bignum_Abs();
  422.         Pop(1);
  423.         Push( Value_Register );
  424.     }
  425.         
  426.     Make_Bignum_Number( nsize );
  427.     Push( Value_Register );            /* zero-initialized quotient */
  428.  
  429.     
  430.         first_denominator_digit = Most_Significant_Digit( DENOMINATOR );
  431.     
  432.     /* Just divide their absolute values, then manipulate signs for
  433.         quotient and remainder later */
  434.  
  435.     while (TRUE)
  436.     {
  437.         accumulator = 0;
  438.                 index = Get_Number_Length(NUMERATOR) - 1;
  439.         while (abs(accumulator) < abs(first_denominator_digit) &&
  440.                                                       index >= 0)
  441.         {
  442.             accumulator *= RADIX;
  443.                         accumulator += Integer_Digit(NUMERATOR,index);
  444.             index--;
  445.         }
  446.  
  447.         first_digit = accumulator / first_denominator_digit;
  448.  
  449.         start_index = index + 1 - (dsize - 1);
  450.  
  451.         if (start_index < 0)
  452.         {
  453.                         Delete_Leading_Zeros( QUOTIENT );
  454.                         Normalize();
  455.             return;
  456.         }
  457.  
  458.                 Get_Number_Digit(QUOTIENT,start_index ) += Low_16(first_digit);
  459.         
  460.         carry = 0;
  461.  
  462.         for ( index = 0; index < dsize; index++ )
  463.         {
  464.             accumulator = - first_digit *
  465.                             Get_Number_Digit(DENOMINATOR,index) +
  466.                 carry + 
  467.                             Get_Number_Digit(NUMERATOR,index + start_index);
  468.  
  469.                         Get_Number_Digit(NUMERATOR, index + start_index) =
  470.                 Low_16( accumulator );
  471.             carry = High_16( accumulator );
  472.  
  473.         }
  474.  
  475.         if (index + start_index < nsize)
  476.         {
  477.                         Get_Number_Digit(NUMERATOR,index+start_index) += carry;
  478.         }
  479.  
  480.                 Delete_Leading_Zeros( NUMERATOR );
  481.  
  482.                 if ((start_index == 0) && Numerator_Less_Than_Denominator())
  483.         {
  484.                         Delete_Leading_Zeros( QUOTIENT );
  485.                         Normalize();
  486.             return;
  487.         }
  488.     }
  489.  
  490. }
  491.  
  492.  
  493.  
  494. Private void Delete_Leading_Zeros( num )
  495.  
  496.     Object num;
  497. {
  498.     /*
  499.        Leading zeros occur in two ways: an explicit leading digit of zero,
  500.        and a leading one (or minus one) followed by a digit of opposite
  501.        sign, ie "-1,5" == "-5".
  502.     */
  503.  
  504.     Short    index = Get_Number_Length(num) - 1;
  505.     Integer    accumulator;
  506.     Short    first_digit;
  507.  
  508.     while (index >= 1)
  509.     {
  510.         if (abs( first_digit = Get_Number_Digit(num,index) ) > 1)
  511.             break;
  512.         if (abs ( accumulator = first_digit * RADIX +
  513.             Get_Number_Digit(num,index-1) ) > MAX_DIGIT)
  514.             break;
  515.         else
  516.         {
  517.             Get_Number_Length(num) = (Integer) index;
  518.             Get_Number_Digit(num,index-1) = Low_16( accumulator );
  519.             index--;
  520.         }
  521.     }
  522. }
  523.  
  524.  
  525.  
  526.  
  527. Public void Bignum_Quotient()
  528. {
  529.     Long_Division();
  530.     Pop(1);     /* popping remainder from stack */
  531. }
  532.  
  533.  
  534.  
  535. Public void Bignum_Remainder()
  536. {
  537.     Long_Division();
  538.     Value_Register = Top(1);
  539.     Pop(1);
  540. }
  541.  
  542.  
  543.  
  544. Public void Bignum_Modulo()
  545. {
  546.     Integer    dsign = Number_Sign( Top(1) ); 
  547.     Integer    nsign = Number_Sign( Top(2) );
  548.     
  549.     Long_Division();
  550.     Value_Register = Top(1);
  551.  
  552.     if ( (nsign * dsign) < 0 )
  553.         /* == "if ((nsign > 0 && dsign < 0) || (nsign < 0 && dsign > 0))"  */
  554.     {
  555.         Push( Top(2) ); /* denominator */
  556.         Bignum_Add(); /* remainder + denominator */
  557.         Pop( 1 );
  558.     }
  559.     
  560.     Pop(1);
  561. }
  562.  
  563.  
  564.  
  565. Public void Bignum_Negate()
  566. {
  567.     Integer len = Get_Number_Length( Top( 1 ) );
  568.     Integer index;
  569.  
  570.     Value_Register = Copy_Object( Top( 1 ) , Bignum_Size( len ) );
  571.     for ( index = 0; index < len; index++ )
  572.     {
  573.         Get_Number_Digit( Value_Register , index ) =
  574.             - Get_Number_Digit( Value_Register , index );
  575.     }
  576. }
  577.  
  578.  
  579.  
  580. Public void Bignum_Abs()
  581. {
  582.     if (Is_Bignum_Negative())
  583.     {
  584.         Bignum_Negate();
  585.     }
  586.     else
  587.     {
  588.         Value_Register = Top(1);
  589.     }
  590. }
  591.  
  592.  
  593.  
  594. Public void Bignum_Numerator()
  595. {
  596.     Value_Register = Top(1);
  597. }
  598.  
  599.  
  600.  
  601. Public void Bignum_Denominator()
  602. {
  603.     Make_Small_Bignum(1);
  604. }
  605.  
  606.  
  607.  
  608. Public void Bignum_Rationalize()
  609. {
  610.     Error("Bignum_Rationalize not yet implemented!");
  611. }
  612.  
  613.  
  614.  
  615. Public void Bignum_Max()
  616. {
  617.     Value_Register = Bignum_Greater_Than() ? Top(2) : Top(1);
  618. }
  619.  
  620.  
  621.  
  622. Public void Bignum_Min()
  623. {
  624.     Value_Register = Bignum_Less_Than() ? Top(2) : Top(1);
  625. }
  626.  
  627.  
  628.  
  629. Public void Bignum_GCD()
  630. {
  631.     /* make arguments positive since gcd is positive */
  632.  
  633.     Push( Top(2) );
  634.     Push( Top(2) );
  635.  
  636.     Bignum_Abs();
  637.     Replace(1, Value_Register);
  638.  
  639.     Push(Top(2));
  640.     Bignum_Abs();
  641.     Replace(1, Value_Register);
  642.  
  643.     while (Number_Sign(Top(1)) != 0)
  644.     {
  645.         Bignum_Remainder();
  646.         Top(2) = Top(1);
  647.         Top(1) = Value_Register;
  648.     }
  649.  
  650.     Value_Register = Top(2);
  651.     
  652.     Pop(3);
  653. }
  654.  
  655.  
  656.  
  657. Public void Bignum_LCM()
  658. {
  659.     /* LCM(a,b) = (a*b)/GCD(a,b)  */
  660.     
  661.     Bignum_Multiply();
  662.     Push(Value_Register);
  663.  
  664.     Push(Top(3));
  665.     Push(Top(3));
  666.  
  667.     Bignum_GCD();
  668.     Push(Value_Register);
  669.  
  670.     Top(2) = Top(4);
  671.     Number_Divide();
  672.  
  673.     Push(Value_Register);
  674.     Number_Abs();
  675.  
  676.     Pop(5);
  677. }
  678.  
  679.  
  680.  
  681.  
  682. Public void Bignum_Floor()
  683. {
  684.     Value_Register = Top(1);
  685. }
  686.  
  687.  
  688.  
  689. Public void Bignum_Ceiling()
  690. {
  691.     Value_Register = Top(1);
  692. }
  693.  
  694.  
  695.  
  696. Public void Bignum_Truncate()
  697. {
  698.     Value_Register = Top(1);
  699. }
  700.  
  701.  
  702.  
  703. Public void Bignum_Round()
  704. {
  705.     Value_Register = Top(1);
  706. }
  707.  
  708.  
  709.  
  710.  
  711. Public void Bignum_Sqrt()
  712. {
  713.     Promote(1, REAL_LEVEL);
  714.     
  715.     if( Get_Number_Real_Value(Top(1)) < 0 )
  716.     {
  717.         Make_Complex_Number( (Double) 0.0 ,
  718.                      sqrt( - Get_Number_Real_Value(Top(1))) );
  719.         }
  720.     else
  721.     {
  722.         Make_Real_Number( sqrt (Get_Number_Real_Value(Top(1))) );
  723.     }
  724. }
  725.  
  726.  
  727.  
  728. Public void Bignum_Exp()
  729. {
  730.     Promote(1, REAL_LEVEL);
  731.  
  732.     Make_Real_Number( exp (Get_Number_Real_Value(Top(1))) );
  733. }
  734.  
  735.  
  736.  
  737. Public void Bignum_Log()
  738. {
  739.     if(Number_Sign(Top(1)) <= 0)
  740.     {
  741.         Error("Argument of log must be positive");
  742.     }
  743.  
  744.  
  745.     Promote(1, REAL_LEVEL);
  746.  
  747.     Make_Real_Number( log (Get_Number_Real_Value(Top(1))) );
  748. }
  749.  
  750.  
  751.  
  752. Public void Bignum_Expt()
  753. {
  754.     Push( Top(2) );
  755.     Is_Number_Negative();
  756.     Pop(1);
  757.  
  758.     if( (Number_Sign(Top(1)) == 0) && (Value_Register == The_True_Object) )
  759.     {
  760.  
  761.         Error("Domain error for expt");
  762.     }
  763.  
  764.     else if (Number_Sign(Top(1)) >= 0)
  765.     {
  766.         Make_Small_Bignum( 1 ); /* running total (initially = 1) */
  767.  
  768.         while ( Number_Sign(Top(1)) > 0 )
  769.         {
  770.             Push( Value_Register );        /* running total */
  771.  
  772.             Push( Top(2) );
  773.             Make_Small_Bignum( 1 );
  774.             Push( Value_Register );
  775.             Number_Subtract();
  776.             Pop(2);
  777.             Replace(2,Value_Register);    /* exponent -= 1 */
  778.  
  779.             Push( Top(3) );            /* total *= mantissa */
  780.             Bignum_Multiply();
  781.             Pop( 2 );
  782.         }
  783.     }
  784.     else
  785.     {
  786.         /* Negative Exponent */
  787.  
  788.         Promote(1, REAL_LEVEL);
  789.         Promote(2, REAL_LEVEL);
  790.  
  791.         Make_Real_Number( pow ( (Get_Number_Real_Value(Top(2))),
  792.                 (Get_Number_Real_Value(Top(1))) ) );
  793.     }
  794. }
  795.  
  796.  
  797.  
  798.  
  799. Public void Bignum_Sin()
  800. {
  801.     Promote(1, REAL_LEVEL);
  802.  
  803.     Make_Real_Number( sin (Get_Number_Real_Value(Top(1))) );
  804. }
  805.  
  806.  
  807.  
  808. Public void Bignum_Cos()
  809. {
  810.     Promote(1, REAL_LEVEL);
  811.  
  812.     Make_Real_Number( cos (Get_Number_Real_Value(Top(1))) );
  813. }
  814.  
  815.  
  816.  
  817. Public void Bignum_Tan()
  818. {
  819.     Promote(1, REAL_LEVEL);
  820.  
  821.     Make_Real_Number( tan (Get_Number_Real_Value(Top(1))) );
  822. }
  823.  
  824.  
  825.  
  826. Public void Bignum_Asin()
  827. {
  828.     Error("Argument of asin must lie between -1 and 1, inclusive");
  829. }
  830.  
  831.  
  832.  
  833. Public void Bignum_Acos()
  834. {
  835.     Error("Argument of acos must lie between -1 and 1, inclusive");
  836. }
  837.  
  838.  
  839.  
  840. Public void Bignum_Atan()
  841. {
  842.     Promote(1, REAL_LEVEL);
  843.  
  844.     Make_Real_Number( atan (Get_Number_Real_Value(Top(1))) );
  845. }
  846.  
  847.  
  848.  
  849. Public void Bignum_Atan2()
  850. {
  851.     Promote(1, REAL_LEVEL);
  852.     Promote(2, REAL_LEVEL);
  853.  
  854.     Make_Real_Number( atan2 (Get_Number_Real_Value(Top(2)), 
  855.                     Get_Number_Real_Value(Top(1))) );
  856. }
  857.  
  858.  
  859.  
  860.  
  861. /* Transfer functions */
  862.  
  863.  
  864. Public void Bignum_Exact_To_Inexact()
  865. {
  866.     Promote( 1 , REAL_LEVEL );
  867.     Value_Register = Top(1);
  868. }
  869.  
  870.  
  871.  
  872. Public void Bignum_Inexact_To_Exact()
  873. {
  874.     Value_Register = Top(1);
  875. }
  876.  
  877. /* BIGNUM TO STRING */
  878.  
  879. Public void Bignum_To_String()
  880.  
  881. {
  882.     Import void String_Append();
  883.  
  884.     Integer    high, low;
  885.     Object    remainder;
  886.     Character partial_string[MAX_CHARS_PER_INT];
  887.     Integer    radix = Number_To_Integer( Top(1) );
  888.     Integer print_radix = 0;
  889.     Object    num = Top(2) ;
  890.  
  891.     switch ( Get_Number_Length( num ) )
  892.     {
  893.     case 0:
  894.         sprintf( partial_string , "%d" , 0 );
  895.         Make_Constant_String( partial_string );
  896.         return;
  897.  
  898.     case 1:
  899.         if ( radix == 10 )
  900.         {
  901.             sprintf( partial_string, "%d", Get_Number_Digit(num,0));
  902.             Make_Constant_String( partial_string );
  903.         }
  904.         else
  905.         {
  906.             Make_Constant_String(
  907.                Integer_To_Cstring( Get_Number_Digit(num,0), 
  908.                         partial_string, radix, 0) );
  909.         }
  910.         return;
  911.         
  912.     case 2:
  913.         if ( radix == 10 )
  914.         {
  915.             sprintf( partial_string , "%d" ,
  916.                     Get_Number_Digit(num,1) * RADIX +
  917.                     Get_Number_Digit(num,0));
  918.             Make_Constant_String( partial_string );
  919.         }
  920.         else
  921.         {
  922.             Make_Constant_String(
  923.                 Integer_To_Cstring((Integer)
  924.                            Get_Number_Digit(num,1) * RADIX +
  925.                            Get_Number_Digit(num,0), 
  926.                         partial_string, radix, 0) );
  927.         }
  928.         return;
  929.  
  930.     default:
  931.         print_radix =    radix == 2  ? 16 :
  932.                 radix == 8  ? 4096 :
  933.                 radix == 10 ? 10000 :
  934.                 radix == 16 ? 65536 : 10000;
  935.  
  936.         Make_Constant_String( "" );
  937.         Push( Value_Register );
  938.         Push( Top( 3 ) ); 
  939.         do {
  940.             Integer_To_Bignum( print_radix );
  941.             Push( Value_Register );
  942.             Long_Division();
  943.             remainder = Top(1);
  944.             Pop(3); /* remainder, print_radix and dividend */
  945.             high = Get_Number_Length( remainder ) == 2
  946.                 ? Get_Number_Digit( remainder , 1)
  947.                 : 0;
  948.             low = Get_Number_Digit( remainder , 0 );
  949.  
  950.             Push( Value_Register );    /* new dividend = quotient */
  951.             
  952.             Make_Constant_String( 
  953.                 Integer_To_Cstring( abs(high * RADIX + low),
  954.                             partial_string, radix, 4) );
  955.             Push( Value_Register );
  956.             Push( Top( 3 ) );
  957.             String_Append(); Pop( 2 );
  958.             Replace( 2 , Value_Register );    
  959.         } while ( Get_Number_Length( Top( 1 ) ) > 2);
  960.         
  961.         Integer_To_Number( radix );
  962.         Push( Value_Register );
  963.         Number_To_String(); Pop( 2 );
  964.         Push( Value_Register );
  965.         Push( Top( 2 ) );
  966.         String_Append(); Pop( 3 );
  967.     }
  968. }
  969.  
  970. Public void Bignum_Make_Rectangular()
  971. {
  972.     Promote(2, REAL_LEVEL);
  973.     Promote(1, REAL_LEVEL);
  974.  
  975.     Make_Complex_Number( Get_Number_Real_Value(Top(2)),
  976.                 Get_Number_Real_Value(Top(1)) );
  977.  
  978. }
  979.  
  980.  
  981.  
  982. Public void Bignum_Make_Polar()
  983.  
  984. #define MAG Get_Number_Real_Value(Top(2))
  985. #define ANG Get_Number_Real_Value(Top(1))
  986.  
  987. {
  988.     Promote( 2, REAL_LEVEL);
  989.     Promote( 1, REAL_LEVEL);
  990.  
  991.     Make_Complex_Number( (MAG) * cos(ANG) , (MAG) * sin(ANG) );
  992.  
  993. }
  994.  
  995. #undef MAG
  996. #undef ANG
  997.  
  998.  
  999.  
  1000. Public void Bignum_Real_Part()
  1001. {
  1002.     Value_Register = Top(1);
  1003. }
  1004.  
  1005.  
  1006.  
  1007. Public void Bignum_Imaginary_Part()
  1008. {
  1009.     Make_Real_Number(0.0);
  1010. }
  1011.  
  1012.  
  1013.  
  1014. Public void Bignum_Magnitude()
  1015. {
  1016.     Bignum_Abs();
  1017. }
  1018.  
  1019.  
  1020.  
  1021. Public void Bignum_Angle()
  1022. {
  1023.     Make_Real_Number(0.0);
  1024. }
  1025.  
  1026.  
  1027.  
  1028.  
  1029.  
  1030. /* OTHER CONVERSIONS INVOLVING BIGNUMS */
  1031.  
  1032.  
  1033. Public void Make_Small_Bignum(num)
  1034.  
  1035.     Integer num;
  1036. {
  1037.     Integer_To_Bignum( num );
  1038. }
  1039.  
  1040.  
  1041.  
  1042. Public Integer Bignum_To_Integer(num)
  1043.  
  1044.     Object num;
  1045. {
  1046.     switch (Get_Number_Length(num))
  1047.     {
  1048.     case 0:
  1049.         return( 0 );
  1050.  
  1051.     case 1:
  1052.         return( Integer_Digit(num,0) );
  1053.  
  1054.     case 2:
  1055.         return( Integer_Digit(num,1) * RADIX + Integer_Digit(num,0) );
  1056.  
  1057.     default:
  1058.         Display_Error("Implementation Restriction; integer too large:", 
  1059.                 num);
  1060.         return( 0 );
  1061.     }
  1062. }
  1063.  
  1064.  
  1065.  
  1066. Public void Integer_To_Bignum(num)
  1067.  
  1068.     Integer num;
  1069. {
  1070.     if (num == 0)
  1071.     {
  1072.         Make_Bignum_Number(1);
  1073.     }
  1074.     else if (abs(num) < RADIX)
  1075.     {
  1076.         Make_Bignum_Number(1);
  1077.         Get_Number_Digit(Value_Register,0) = num;
  1078.     }
  1079.     else
  1080.     {
  1081.         Make_Bignum_Number(2);
  1082.         Get_Number_Digit(Value_Register,0) = Low_16(num);
  1083.         Get_Number_Digit(Value_Register,1) = High_16(num);
  1084.     }
  1085. }
  1086.  
  1087.  
  1088.  
  1089. /* Bignum Diagnostics */
  1090.  
  1091. /*
  1092.  
  1093. Private void Shownum( title , num )
  1094.  
  1095.     String title;
  1096.     Object num ;
  1097. {
  1098.     if ( Is_String(num) )
  1099.     {
  1100.         printf( "%s: <string \"%s\">" , title , Get_String_Value(num));
  1101.         return;
  1102.     }
  1103.  
  1104.     if ( Is_Number( num ) && Get_Number_Tower_Position(num) == REAL_LEVEL )
  1105.     {
  1106.         printf( "%s: <real %f>" , title , Get_Number_Real_Value(num));
  1107.         return;
  1108.     }
  1109.     if ( ! Is_Number(num) || Get_Number_Tower_Position(num) != BIGNUM_LEVEL)
  1110.     {
  1111.         printf( "%s: <NOT A BIGNUM>" , title );
  1112.     }
  1113.     else
  1114.     {
  1115.         Integer index;
  1116.         Integer len = Get_Number_Length(num);
  1117.  
  1118.         printf( "%s: { %d:" , title ,  len );
  1119.         for ( index = 0; index < len; index ++ )
  1120.         {
  1121.             printf( " %d" , Get_Number_Digit(num,index) );
  1122.         }
  1123.  
  1124.         printf( "}" );
  1125.     }
  1126. }
  1127. */
  1128.