home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / num_arith.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  23.2 KB  |  1,226 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. /*
  23.     Arithmetic operations
  24. */
  25. #include "include.h"
  26. #include "mp.h"
  27. #include "num_include.h"
  28.  
  29. object
  30. bignum2(most, least)
  31. int most, least;
  32. { static  long u [4] 
  33.    = {0x01010004 ,0x01010004, 0,0};
  34.   GEN w;
  35.   int l;
  36.   if(most) {setlgef(u,4),l=4;}
  37.     else {l=3; setlgef(u,3);}
  38.   MP_START_LOW(w,u,l);
  39.   MP_NEXT_UP(w) = least;
  40.   if (most) MP_NEXT_UP(w) = most;
  41.  return  make_integer(u);
  42. }
  43.  
  44. object
  45. fixnum_times(i, j)
  46. int i, j;
  47. { MPOP(return,mulss,i,j);
  48. }
  49.  
  50. object
  51. number_to_complex(x)
  52. object x;
  53. {
  54.     object z;
  55.  
  56.     switch (type_of(x)) {
  57.  
  58.     case t_fixnum:
  59.     case t_bignum:
  60.     case t_ratio:
  61.     case t_shortfloat:
  62.     case t_longfloat:
  63.         z = alloc_object(t_complex);
  64.         z->cmp.cmp_real = x;
  65.         z->cmp.cmp_imag = small_fixnum(0);
  66.         return(z);
  67.  
  68.     case t_complex:
  69.         return(x);
  70.  
  71.     default:
  72.         FEwrong_type_argument(Snumber, x);
  73.     }
  74. }
  75.  
  76. object
  77. number_plus(x, y)
  78. object x, y;
  79. {
  80.     int i, j, k;
  81.     double dx, dy;
  82.     object z, z1;
  83.     vs_mark;
  84.     
  85.     switch (type_of(x)) {
  86.  
  87.     case t_fixnum:
  88.         switch(type_of(y)) {
  89.         case t_fixnum:
  90.           MPOP(return, addss,fix(x),fix(y));
  91.         case t_bignum:
  92.           MPOP(return, addsi,fix(x),MP(y));
  93.         case t_ratio:
  94.             vs_push(number_times(x, y->rat.rat_den));
  95.             z = number_plus(vs_top[-1], y->rat.rat_num);
  96.             vs_push(z);
  97.             z = make_ratio(z, y->rat.rat_den);
  98.             vs_reset;
  99.             return(z);
  100.         case t_shortfloat:
  101.             dx = (double)(fix(x));
  102.             dy = (double)(sf(y));
  103.             goto SHORTFLOAT;
  104.         case t_longfloat:
  105.             dx = (double)(fix(x));
  106.             dy = lf(y);
  107.             goto LONGFLOAT;
  108.         case t_complex:
  109.             goto COMPLEX;
  110.         default:
  111.             FEwrong_type_argument(Snumber, y);
  112.         }
  113.  
  114.     case t_bignum:
  115.         switch (type_of(y)) {
  116.         case t_fixnum:
  117.           MPOP(return,addsi,fix(y),MP(x)); 
  118.         case t_bignum:
  119.           MPOP(return,addii,MP(y),MP(x)); 
  120.         case t_ratio:
  121.             vs_push(number_times(x, y->rat.rat_den));
  122.             z = number_plus(vs_top[-1], y->rat.rat_num);
  123.             vs_push(z);
  124.             z = make_ratio(z, y->rat.rat_den);
  125.             vs_reset;
  126.             return(z);
  127.         case t_shortfloat:
  128.             dx = number_to_double(x);
  129.             dy = (double)(sf(y));
  130.             goto SHORTFLOAT;
  131.         case t_longfloat:
  132.             dx = number_to_double(x);
  133.             dy = lf(y);
  134.             goto LONGFLOAT;
  135.         case t_complex:
  136.             goto COMPLEX;
  137.         default:
  138.             FEwrong_type_argument(Snumber, y);
  139.         }
  140.  
  141.     case t_ratio:
  142.         switch (type_of(y)) {
  143.         case t_fixnum:
  144.         case t_bignum:
  145.             vs_push(number_times(x->rat.rat_den, y));
  146.             z = number_plus(x->rat.rat_num, vs_top[-1]);
  147.             vs_push(z);
  148.             z = make_ratio(z, x->rat.rat_den);
  149.             vs_reset;
  150.             return(z);
  151.         case t_ratio:
  152.             vs_push(number_times(x->rat.rat_num,y->rat.rat_den));
  153.             vs_push(number_times(x->rat.rat_den,y->rat.rat_num));
  154.             z = number_plus(vs_top[-2], vs_top[-1]);
  155.             vs_push(z);
  156.             vs_push(number_times(x->rat.rat_den,y->rat.rat_den));
  157.             z = make_ratio(z, vs_top[-1]);
  158.             vs_reset;
  159.             return(z);
  160.         case t_shortfloat:
  161.             dx = number_to_double(x);
  162.             dy = (double)(sf(y));
  163.             goto SHORTFLOAT;
  164.         case t_longfloat:
  165.             dx = number_to_double(x);
  166.             dy = lf(y);
  167.             goto LONGFLOAT;
  168.         case t_complex:
  169.             goto COMPLEX;
  170.         default:
  171.             FEwrong_type_argument(Snumber, y);
  172.         }
  173.  
  174.     case t_shortfloat:
  175.         switch (type_of(y)) {
  176.         case t_fixnum:
  177.             dx = (double)(sf(x));
  178.             dy = (double)(fix(y));
  179.             goto SHORTFLOAT;
  180.         case t_shortfloat:
  181.             dx = (double)(sf(x));
  182.             dy = (double)(sf(y));
  183.             goto SHORTFLOAT;
  184.         case t_longfloat:
  185.             dx = (double)(sf(x));
  186.             dy = lf(y);
  187.             goto LONGFLOAT;
  188.         case t_complex:
  189.             goto COMPLEX;
  190.         default:
  191.             dx = (double)(sf(x));
  192.             dy = number_to_double(y);
  193.             goto SHORTFLOAT;
  194.         }
  195.     SHORTFLOAT:
  196.         z = alloc_object(t_shortfloat);
  197.         sf(z) = (shortfloat)(dx + dy);
  198.         return(z);
  199.  
  200.     case t_longfloat:
  201.         dx = lf(x);
  202.         switch (type_of(y)) {
  203.         case t_fixnum:
  204.             dy = (double)(fix(y));
  205.             goto LONGFLOAT;
  206.         case t_shortfloat:
  207.             dy = (double)(sf(y));
  208.             goto LONGFLOAT;
  209.         case t_longfloat:
  210.             dy = lf(y);
  211.             goto LONGFLOAT;
  212.         case t_complex:
  213.             goto COMPLEX;
  214.         default:
  215.             dy = number_to_double(y);
  216.             goto LONGFLOAT;
  217.         }
  218.     LONGFLOAT:
  219.         z = alloc_object(t_longfloat);
  220.         lf(z) = dx + dy;
  221.         return(z);
  222.  
  223.     case t_complex:
  224.     COMPLEX:
  225.         x = number_to_complex(x);
  226.         vs_push(x);
  227.         y = number_to_complex(y);
  228.         vs_push(y);
  229.         vs_push(number_plus(x->cmp.cmp_real, y->cmp.cmp_real));
  230.         vs_push(number_plus(x->cmp.cmp_imag, y->cmp.cmp_imag));
  231.         z = make_complex(vs_top[-2], vs_top[-1]);
  232.         vs_reset;
  233.         return(z);
  234.  
  235.     default:
  236.         FEwrong_type_argument(Snumber, x);
  237.     }
  238. }
  239.  
  240. object
  241. one_plus(x)
  242. object x;
  243. {
  244.     int i;
  245.     double dx;
  246.     object z, z1;
  247.     vs_mark;
  248.     
  249.     switch (type_of(x)) {
  250.  
  251.     case t_fixnum:
  252.       MPOP(return, addss,1,fix(x));
  253.     case t_bignum:
  254.       MPOP(return, addsi,1,MP(x));
  255.     case t_ratio:
  256.         z = number_plus(x->rat.rat_num, x->rat.rat_den);
  257.         vs_push(z);
  258.         z = make_ratio(z, x->rat.rat_den);
  259.         vs_reset;
  260.         return(z);
  261.  
  262.     case t_shortfloat:
  263.         dx = (double)(sf(x));
  264.         z = alloc_object(t_shortfloat);
  265.         sf(z) = (shortfloat)(dx + 1.0);
  266.         return(z);
  267.  
  268.     case t_longfloat:
  269.         dx = lf(x);
  270.         z = alloc_object(t_longfloat);
  271.         lf(z) = dx + 1.0;
  272.         return(z);
  273.  
  274.     case t_complex:
  275.     COMPLEX:
  276.         vs_push(one_plus(x->cmp.cmp_real));
  277.         z = make_complex(vs_top[-1], x->cmp.cmp_imag);
  278.         vs_reset;
  279.         return(z);
  280.  
  281.     default:
  282.         FEwrong_type_argument(Snumber, x);
  283.     }
  284. }
  285.  
  286. object
  287. number_minus(x, y)
  288. object x, y;
  289. {
  290.     int i, j, k;
  291.     double dx, dy;
  292.     object z, z1;
  293.     vs_mark;
  294.     
  295.     switch (type_of(x)) {
  296.  
  297.     case t_fixnum:
  298.         switch(type_of(y)) {
  299. #define MOST_NEG_FIXNUM (1 << 31)          
  300.         case t_fixnum:
  301.           MPOP(return,subss,fix(x),fix(y));
  302.         case t_bignum:
  303.           MPOP(return, subsi,fix(x),MP(y));
  304.         case t_ratio:
  305.             vs_push(number_times(x, y->rat.rat_den));
  306.             z = number_minus(vs_top[-1], y->rat.rat_num);
  307.             vs_push(z);
  308.             z = make_ratio(z, y->rat.rat_den);
  309.             vs_reset;
  310.             return(z);
  311.         case t_shortfloat:
  312.             dx = (double)(fix(x));
  313.             dy = (double)(sf(y));
  314.             goto SHORTFLOAT;
  315.         case t_longfloat:
  316.             dx = (double)(fix(x));
  317.             dy = lf(y);
  318.             goto LONGFLOAT;
  319.         case t_complex:
  320.             goto COMPLEX;
  321.         default:
  322.             FEwrong_type_argument(Snumber, y);
  323.         }
  324.  
  325.     case t_bignum:
  326.         switch (type_of(y)) {
  327.         case t_fixnum:
  328.           MPOP(return,subis,MP(x),fix(y));
  329.         case t_bignum:
  330.           MPOP(return,subii,MP(x),MP(y));
  331.         case t_ratio:
  332.             vs_push(number_times(x, y->rat.rat_den));
  333.             z = number_minus(vs_top[-1], y->rat.rat_num);
  334.             vs_push(z);
  335.             z = make_ratio(z, y->rat.rat_den);
  336.             vs_reset;
  337.             return(z);
  338.         case t_shortfloat:
  339.             dx = number_to_double(x);
  340.             dy = (double)(sf(y));
  341.             goto SHORTFLOAT;
  342.         case t_longfloat:
  343.             dx = number_to_double(x);
  344.             dy = lf(y);
  345.             goto LONGFLOAT;
  346.         case t_complex:
  347.             goto COMPLEX;
  348.         default:
  349.             FEwrong_type_argument(Snumber, y);
  350.         }
  351.  
  352.     case t_ratio:
  353.         switch (type_of(y)) {
  354.         case t_fixnum:
  355.         case t_bignum:
  356.             vs_push(number_times(x->rat.rat_den, y));
  357.             z = number_minus(x->rat.rat_num, vs_top[-1]);
  358.             vs_push(z);
  359.             z = make_ratio(z, x->rat.rat_den);
  360.             vs_reset;
  361.             return(z);
  362.         case t_ratio:
  363.             vs_push(number_times(x->rat.rat_num,y->rat.rat_den));
  364.             vs_push(number_times(x->rat.rat_den,y->rat.rat_num));
  365.             z = number_minus(vs_top[-2], vs_top[-1]);
  366.             vs_push(z);
  367.             vs_push(number_times(x->rat.rat_den,y->rat.rat_den));
  368.             z = make_ratio(z, vs_top[-1]);
  369.             vs_reset;
  370.             return(z);
  371.         case t_shortfloat:
  372.             dx = number_to_double(x);
  373.             dy = (double)(sf(y));
  374.             goto SHORTFLOAT;
  375.         case t_longfloat:
  376.             dx = number_to_double(x);
  377.             dy = lf(y);
  378.             goto LONGFLOAT;
  379.         case t_complex:
  380.             goto COMPLEX;
  381.         default:
  382.             FEwrong_type_argument(Snumber, y);
  383.         }
  384.  
  385.     case t_shortfloat:
  386.         switch (type_of(y)) {
  387.         case t_fixnum:
  388.             dx = (double)(sf(x));
  389.             dy = (double)(fix(y));
  390.             goto SHORTFLOAT;
  391.         case t_shortfloat:
  392.             dx = (double)(sf(x));
  393.             dy = (double)(sf(y));
  394.             goto SHORTFLOAT;
  395.         case t_longfloat:
  396.             dx = (double)(sf(x));
  397.             dy = lf(y);
  398.             goto LONGFLOAT;
  399.         case t_complex:
  400.             goto COMPLEX;
  401.         default:
  402.             dx = (double)(sf(x));
  403.             dy = number_to_double(y);
  404.             goto SHORTFLOAT;
  405.         }
  406.     SHORTFLOAT:
  407.         z = alloc_object(t_shortfloat);
  408.         sf(z) = (shortfloat)(dx - dy);
  409.         return(z);
  410.  
  411.     case t_longfloat:
  412.         dx = lf(x);
  413.         switch (type_of(y)) {
  414.         case t_fixnum:
  415.             dy = (double)(fix(y));
  416.             goto LONGFLOAT;
  417.         case t_shortfloat:
  418.             dy = (double)(sf(y));
  419.             goto LONGFLOAT;
  420.         case t_longfloat:
  421.             dy = lf(y);
  422.             goto LONGFLOAT;
  423.         case t_complex:
  424.             goto COMPLEX;
  425.         default:
  426.             dy = number_to_double(y);
  427.         }
  428.     LONGFLOAT:
  429.         z = alloc_object(t_longfloat);
  430.         lf(z) = dx - dy;
  431.         return(z);
  432.  
  433.     case t_complex:
  434.     COMPLEX:
  435.         x = number_to_complex(x);
  436.         vs_push(x);
  437.         y = number_to_complex(y);
  438.         vs_push(y);
  439.         vs_push(number_minus(x->cmp.cmp_real, y->cmp.cmp_real));
  440.         vs_push(number_minus(x->cmp.cmp_imag, y->cmp.cmp_imag));
  441.         z = make_complex(vs_top[-2], vs_top[-1]);
  442.         vs_reset;
  443.         return(z);
  444.  
  445.     default:
  446.         FEwrong_type_argument(Snumber, x);
  447.     }
  448. }
  449.  
  450. object
  451. one_minus(x)
  452. object x;
  453. {
  454.     int i;
  455.     double dx;
  456.     object z, z1;
  457.     vs_mark;
  458.     
  459.     switch (type_of(x)) {
  460.  
  461.     case t_fixnum:
  462.       MPOP(return,addss,fix(x),-1);
  463.     case t_bignum:
  464.       MPOP(return,addsi,-1,MP(x));
  465.     case t_ratio:
  466.         z = number_minus(x->rat.rat_num, x->rat.rat_den);
  467.         vs_push(z);
  468.         z = make_ratio(z, x->rat.rat_den);
  469.         vs_reset;
  470.         return(z);
  471.  
  472.     case t_shortfloat:
  473.         dx = (double)(sf(x));
  474.         z = alloc_object(t_shortfloat);
  475.         sf(z) = (shortfloat)(dx - 1.0);
  476.         return(z);
  477.  
  478.     case t_longfloat:
  479.         dx = lf(x);
  480.         z = alloc_object(t_longfloat);
  481.         lf(z) = dx - 1.0;
  482.         return(z);
  483.  
  484.     case t_complex:
  485.     COMPLEX:
  486.         vs_push(one_minus(x->cmp.cmp_real));
  487.         z = make_complex(vs_top[-1], x->cmp.cmp_imag);
  488.         vs_reset;
  489.         return(z);
  490.  
  491.     default:
  492.         FEwrong_type_argument(Snumber, x);
  493.     }
  494. }
  495.  
  496. object
  497. number_negate(x)
  498. object x;
  499. {
  500.     object    z, z1;
  501.     vs_mark;
  502.  
  503.     switch (type_of(x)) {
  504.  
  505.     case t_fixnum:
  506.         if(fix(x) == MOST_NEGATIVE_FIX)
  507.           return make_bignum(ABS_MOST_NEGS);
  508.         else
  509.           return(make_fixnum(-fix(x)));
  510.     case t_bignum:
  511.         return big_minus(x);
  512.     case t_ratio:
  513.         z1 = number_negate(x->rat.rat_num);
  514.         vs_push(z1);
  515.         z = alloc_object(t_ratio);
  516.         z->rat.rat_num = z1;
  517.         z->rat.rat_den = x->rat.rat_den;
  518.         vs_reset;
  519.         return(z);
  520.  
  521.     case t_shortfloat:
  522.         z = alloc_object(t_shortfloat);
  523.         sf(z) = -sf(x);
  524.         return(z);
  525.  
  526.     case t_longfloat:
  527.         z = alloc_object(t_longfloat);
  528.         lf(z) = -lf(x);
  529.         return(z);
  530.  
  531.     case t_complex:
  532.         vs_push(number_negate(x->cmp.cmp_real));
  533.         vs_push(number_negate(x->cmp.cmp_imag));
  534.         z = make_complex(vs_top[-2], vs_top[-1]);
  535.         vs_reset;
  536.         return(z);
  537.  
  538.     default:
  539.         FEwrong_type_argument(Snumber, x);
  540.     }
  541. }
  542.  
  543. object
  544. number_times(x, y)
  545. object x, y;
  546. {
  547.     object z;
  548.     double dx, dy;
  549.     vs_mark;
  550.  
  551.     switch (type_of(x)) {
  552.  
  553.     case t_fixnum:
  554.         switch (type_of(y)) {
  555.         case t_fixnum:
  556.           MPOP(return,mulss,fix(x),fix(y));
  557.         case t_bignum:
  558.           MPOP(return,mulsi,fix(x),MP(y));
  559.         case t_ratio:
  560.             vs_push(number_times(x, y->rat.rat_num));
  561.             z = make_ratio(vs_top[-1], y->rat.rat_den);
  562.             vs_reset;
  563.             return(z);
  564.         case t_shortfloat:
  565.             dx = (double)(fix(x));
  566.             dy = (double)(sf(y));
  567.             goto SHORTFLOAT;
  568.         case t_longfloat:
  569.             dx = (double)(fix(x));
  570.             dy = lf(y);
  571.             goto LONGFLOAT;
  572.         case t_complex:
  573.             goto COMPLEX;
  574.         default:
  575.             FEwrong_type_argument(Snumber, y);
  576.         }
  577.  
  578.     case t_bignum:
  579.         switch (type_of(y)) {
  580.         case t_fixnum:
  581.            MPOP(return,mulsi,fix(y),MP(x));
  582.  
  583.         case t_bignum:
  584.           MPOP(return,mulii,MP(y),MP(x));
  585.         case t_ratio:
  586.             vs_push(number_times(x, y->rat.rat_num));
  587.             z = make_ratio(vs_top[-1], y->rat.rat_den);
  588.             vs_reset;
  589.             return(z);
  590.         case t_shortfloat:
  591.             dx = number_to_double(x);
  592.             dy = (double)(sf(y));
  593.             goto SHORTFLOAT;
  594.         case t_longfloat:
  595.             dx = number_to_double(x);
  596.             dy = lf(y);
  597.             goto LONGFLOAT;
  598.         case t_complex:
  599.             goto COMPLEX;
  600.         default:
  601.             FEwrong_type_argument(Snumber, y);
  602.         }
  603.  
  604.     case t_ratio:
  605.         switch (type_of(y)) {
  606.         case t_fixnum:
  607.         case t_bignum:
  608.             vs_push(number_times(x->rat.rat_num, y));
  609.             z = make_ratio(vs_top[-1], x->rat.rat_den);
  610.             vs_reset;
  611.             return(z);
  612.         case t_ratio:
  613.             vs_push(number_times(x->rat.rat_num,y->rat.rat_num));
  614.             vs_push(number_times(x->rat.rat_den,y->rat.rat_den));
  615.             z = make_ratio(vs_top[-2], vs_top[-1]);
  616.             vs_reset;
  617.             return(z);
  618.         case t_shortfloat:
  619.             dx = number_to_double(x);
  620.             dy = (double)(sf(y));
  621.             goto SHORTFLOAT;
  622.         case t_longfloat:
  623.             dx = number_to_double(x);
  624.             dy = lf(y);
  625.             goto LONGFLOAT;
  626.         case t_complex:
  627.             goto COMPLEX;
  628.         default:
  629.             FEwrong_type_argument(Snumber, y);
  630.         }
  631.  
  632.     case t_shortfloat:
  633.         switch (type_of(y)) {
  634.         case t_fixnum:
  635.             dx = (double)(sf(x));
  636.             dy = (double)(fix(y));
  637.             goto SHORTFLOAT;
  638.         case t_shortfloat:
  639.             dx = (double)(sf(x));
  640.             dy = (double)(sf(y));
  641.             goto SHORTFLOAT;
  642.         case t_longfloat:
  643.             dx = (double)(sf(x));
  644.             dy = lf(y);
  645.             goto LONGFLOAT;
  646.         case t_complex:
  647.             goto COMPLEX;
  648.         default:
  649.             dx = (double)(sf(x));
  650.             dy = number_to_double(y);
  651.             break;
  652.         }
  653.     SHORTFLOAT:
  654.         z = alloc_object(t_shortfloat);
  655.         sf(z) = (shortfloat)(dx * dy);
  656.         return(z);
  657.  
  658.     case t_longfloat:
  659.         dx = lf(x);
  660.         switch (type_of(y)) {
  661.         case t_fixnum:
  662.             dy = (double)(fix(y));
  663.             goto LONGFLOAT;
  664.         case t_shortfloat:
  665.             dy = (double)(sf(y));
  666.             goto LONGFLOAT;
  667.         case t_longfloat:
  668.             dy = lf(y);
  669.             goto LONGFLOAT;
  670.         case t_complex:
  671.             goto COMPLEX;
  672.         default:
  673.             dy = number_to_double(y);
  674.         }
  675.     LONGFLOAT:
  676.         z = alloc_object(t_longfloat);
  677.         lf(z) = dx * dy;
  678.         return(z);
  679.  
  680.     case t_complex:
  681.     COMPLEX:
  682.     {
  683.         object z1, z2, z11, z12, z21, z22;
  684.  
  685.         x = number_to_complex(x);
  686.         vs_push(x);
  687.         y = number_to_complex(y);
  688.         vs_push(y);
  689.         z11 = number_times(x->cmp.cmp_real, y->cmp.cmp_real);
  690.         vs_push(z11);
  691.         z12 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag);
  692.         vs_push(z12);
  693.         z21 = number_times(x->cmp.cmp_imag, y->cmp.cmp_real);
  694.         vs_push(z21);
  695.         z22 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag);
  696.         vs_push(z22);
  697.         z1 =  number_minus(z11, z12);
  698.         vs_push(z1);
  699.         z2 =  number_plus(z21, z22);
  700.         vs_push(z2);
  701.         z = make_complex(z1, z2);
  702.         vs_reset;
  703.         return(z);
  704.     }
  705.  
  706.     default:
  707.         FEwrong_type_argument(Snumber, x);
  708.     }
  709. }
  710.  
  711. object
  712. number_divide(x, y)
  713. object x, y;
  714. {
  715.     object z;
  716.     double dx, dy;
  717.     vs_mark;
  718.  
  719.     switch (type_of(x)) {
  720.  
  721.     case t_fixnum:
  722.     case t_bignum:
  723.         switch (type_of(y)) {
  724.         case t_fixnum:
  725.         case t_bignum:
  726.             if(number_zerop(y) == TRUE)
  727.                 zero_divisor();
  728.             if (number_minusp(y) == TRUE) {
  729.                 x = number_negate(x);
  730.                 vs_push(x);
  731.                 y = number_negate(y);
  732.                 vs_push(y);
  733.             }
  734.             z = make_ratio(x, y);
  735.             vs_reset;
  736.             return(z);
  737.         case t_ratio:
  738.             if(number_zerop(y->rat.rat_num))
  739.                 zero_divisor();
  740.             vs_push(number_times(x, y->rat.rat_den));
  741.             z = make_ratio(vs_top[-1], y->rat.rat_num);
  742.             vs_reset;
  743.             return(z);
  744.         case t_shortfloat:
  745.             dx = number_to_double(x);
  746.             dy = (double)(sf(y));
  747.             goto SHORTFLOAT;
  748.         case t_longfloat:
  749.             dx = number_to_double(x);
  750.             dy = lf(y);
  751.             goto LONGFLOAT;
  752.         case t_complex:
  753.             goto COMPLEX;
  754.         default:
  755.             FEwrong_type_argument(Snumber, y);
  756.         }
  757.  
  758.     case t_ratio:
  759.         switch (type_of(y)) {
  760.         case t_fixnum:
  761.         case t_bignum:
  762.             if (number_zerop(y))
  763.                 zero_divisor();
  764.             vs_push(number_times(x->rat.rat_den, y));
  765.             z = make_ratio(x->rat.rat_num, vs_top[-1]);
  766.             vs_reset;
  767.             return(z);
  768.         case t_ratio:
  769.             vs_push(number_times(x->rat.rat_num,y->rat.rat_den));
  770.             vs_push(number_times(x->rat.rat_den,y->rat.rat_num));
  771.             z = make_ratio(vs_top[-2], vs_top[-1]);
  772.             vs_reset;
  773.             return(z);
  774.         case t_shortfloat:
  775.             dx = number_to_double(x);
  776.             dy = (double)(sf(y));
  777.             goto SHORTFLOAT;
  778.         case t_longfloat:
  779.             dx = number_to_double(x);
  780.             dy = lf(y);
  781.             goto LONGFLOAT;
  782.         case t_complex:
  783.             goto COMPLEX;
  784.         default:
  785.             FEwrong_type_argument(Snumber, y);
  786.         }
  787.  
  788.     case t_shortfloat:
  789.         switch (type_of(y)) {
  790.         case t_fixnum:
  791.             dx = (double)(sf(x));
  792.             dy = (double)(fix(y));
  793.             goto SHORTFLOAT;
  794.         case t_shortfloat:
  795.             dx = (double)(sf(x));
  796.             dy = (double)(sf(y));
  797.             goto SHORTFLOAT;
  798.         case t_longfloat:
  799.             dx = (double)(sf(x));
  800.             dy = lf(y);
  801.             goto LONGFLOAT;
  802.         case t_complex:
  803.             goto COMPLEX;
  804.         default:
  805.             dx = (double)(sf(x));
  806.             dy = number_to_double(y);
  807.             goto LONGFLOAT;
  808.         }
  809.     SHORTFLOAT:
  810.         z = alloc_object(t_shortfloat);
  811.         if (dy == 0.0)
  812.             zero_divisor();
  813.         sf(z) = (shortfloat)(dx / dy);
  814.         return(z);
  815.  
  816.  
  817.     case t_longfloat:
  818.         dx = lf(x);
  819.         switch (type_of(y)) {
  820.         case t_fixnum:
  821.             dy = (double)(fix(y));
  822.             goto LONGFLOAT;
  823.         case t_shortfloat:
  824.             dy = (double)(sf(y));
  825.             goto LONGFLOAT;
  826.         case t_longfloat:
  827.             dy = lf(y);
  828.             goto LONGFLOAT;
  829.         case t_complex:
  830.             goto COMPLEX;
  831.         default:
  832.             dy = number_to_double(y);
  833.         }
  834.     LONGFLOAT:
  835.         z = alloc_object(t_longfloat);
  836.         if (dy == 0.0)
  837.             zero_divisor();
  838.         lf(z) = dx / dy;
  839.         return(z);
  840.  
  841.     case t_complex:
  842.     COMPLEX:
  843.     {
  844.         object z1, z2, z3;
  845.  
  846.         x = number_to_complex(x);
  847.         vs_push(x);
  848.         y = number_to_complex(y);
  849.         vs_push(y);
  850.         z1 = number_times(y->cmp.cmp_real, y->cmp.cmp_real);
  851.         vs_push(z1);
  852.         z2 = number_times(y->cmp.cmp_imag, y->cmp.cmp_imag);
  853.         vs_push(z2);
  854.         if (number_zerop(z3 = number_plus(z1, z2)))
  855.             zero_divisor();
  856.         vs_push(z3);
  857.         z1 = number_times(x->cmp.cmp_real, y->cmp.cmp_real);
  858.         vs_push(z1);
  859.         z2 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag);
  860.         vs_push(z2);
  861.         z1 = number_plus(z1, z2);
  862.         vs_push(z1);
  863.         z = number_times(x->cmp.cmp_imag, y->cmp.cmp_real);
  864.         vs_push(z);
  865.         z2 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag);
  866.         vs_push(z2);
  867.         z2 = number_minus(z, z2);
  868.         vs_push(z2);
  869.         z1 = number_divide(z1, z3);
  870.         vs_push(z1);
  871.         z2 = number_divide(z2, z3);
  872.         vs_push(z2);
  873.         z = make_complex(z1, z2);
  874.         vs_reset;
  875.         return(z);
  876.     }
  877.  
  878.     default:
  879.         FEwrong_type_argument(Snumber, x);
  880.     }
  881. }
  882.  
  883. integer_quotient_remainder_1(x, y, qp, rp)
  884. object x, y;
  885. object *qp, *rp;
  886. {  GEN res,quot,x0,y0;
  887.   save_avma;
  888.   if (type_of(x)==t_fixnum) x0 = stoi(fix(x));
  889.    else x0=MP(x); 
  890.   if (type_of(y)==t_fixnum) y0 = stoi(fix(y));
  891.    else y0=MP(y);
  892.   res = dvmdii(x0,y0,");
  893.   restore_avma;
  894.   *qp = make_integer(res);
  895.   *rp = make_integer(quot);
  896.   return;
  897.  }
  898.       
  899.  
  900. /* old
  901. integer_quotient_remainder_1(x, y, qp, rp)
  902. object x, y;
  903. object *qp, *rp;
  904. {
  905.     enum type tx, ty;
  906.     int i, j, q, r;
  907.     vs_mark;
  908.         
  909.     tx = type_of(x);
  910.     ty = type_of(y);
  911.     if (tx == t_fixnum) {
  912.          if (ty == t_fixnum) {
  913.             if (fix(y) == 0)
  914.                 zero_divisor();
  915.             if (fix(y) == MOST_NEGATIVE_FIX)
  916.                 if (fix(x) == MOST_NEGATIVE_FIX) {
  917.                     *qp = small_fixnum(1);
  918.                     *rp = small_fixnum(0);
  919.                     return;
  920.                 } else {
  921.                     *qp = small_fixnum(0);
  922.                     *rp = x;
  923.                     return;
  924.                 }
  925.             if (fix(x) == MOST_NEGATIVE_FIX) {
  926.                 if (fix(y) == 1) {
  927.                     *qp = x;
  928.                     *rp = small_fixnum(0);
  929.                     return;
  930.                 }
  931.                 if (fix(y) == -1) {
  932.                     *qp = bignum2(1, 0);
  933.                     *rp = small_fixnum(0);
  934.                     return;
  935.                 }
  936.                 if (fix(y) > 0) {
  937.                     extended_div(fix(y), 1, 0,
  938.                              &q, &r);
  939.                     *qp = make_fixnum(-q);
  940.                     vs_push(*qp);
  941.                     *rp = make_fixnum(-r);
  942.                     vs_reset;
  943.                     return;
  944.                 } else {
  945.                     extended_div(-fix(y), 1, 0,
  946.                              &q, &r);
  947.                     *qp = make_fixnum(q);
  948.                     vs_push(*qp);
  949.                     *rp = make_fixnum(-r);
  950.                     vs_reset;
  951.                     return;
  952.                 }
  953.             }
  954.             *qp = make_fixnum(fix(x) / fix(y));
  955.             vs_push(*qp);
  956.             *rp = make_fixnum(fix(x) % fix(y));
  957.             vs_reset;
  958.             return;
  959.         }
  960.         if (ty == t_bignum) {
  961.             if (fix(x) == MOST_NEGATIVE_FIX &&
  962.                 MP(y)[2] == MOST_NEGATIVE_FIX &&
  963.                 lgef(MP(y)) == 1 &&
  964.                 signe(MP(y)) < 0)
  965.               {
  966.                 *qp = small_fixnum(-1);
  967.                 *rp = small_fixnum(0);
  968.                 return;
  969.                   }
  970.             *qp = small_fixnum(0);
  971.             *rp = x;
  972.             return;
  973.         } else
  974.             FEwrong_type_argument(Sinteger, y);
  975.     }
  976.     if (tx == t_bignum) {
  977.         if (ty == t_fixnum)
  978.           { 
  979.              MPOP(*qp = ,divis,MP(x),fix(y));
  980.              *rp = make_fixnum(hiremainder);
  981.              return;
  982.            }
  983.         else
  984.           if (ty == t_bignum)
  985. #define Dvmdii(a,b) dvmdii(a,b,&p1)
  986.             {GEN p1;
  987.              MPOP(*qp = ,dvmdii,MP(x),MP(y));
  988.              *rp = make_integer(p1);
  989.              return;}
  990.         else
  991.             FEwrong_type_argument(Sinteger, y);
  992.     }
  993.     FEwrong_type_argument(Sinteger, x);
  994. }
  995. */
  996.  
  997. object
  998. integer_divide1(x, y)
  999. object x, y;
  1000. {
  1001.     object q, r;
  1002.  
  1003.     integer_quotient_remainder_1(x, y, &q, &r);
  1004.     return(q);
  1005. }
  1006.  
  1007. object
  1008. get_gcd(x, y)
  1009. object    x, y;
  1010. {
  1011.     int    i, j, k;
  1012.     object    q, r;
  1013.     vs_mark;
  1014.  
  1015.     if (number_minusp(x))
  1016.         x = number_negate(x);
  1017.     vs_push(x);
  1018.     if (number_minusp(y))
  1019.         y = number_negate(y);
  1020.     vs_push(y);
  1021.  
  1022. L:
  1023.     if (type_of(x) == t_fixnum && type_of(y) == t_fixnum) {
  1024.         i = fix(x);
  1025.         j = fix(y);
  1026. LL:
  1027.         if (i < j) {
  1028.             k = i;
  1029.             i = j;
  1030.             j = k;
  1031.         }
  1032.         if (j == 0) {
  1033.             vs_reset;
  1034.             return(make_fixnum(i));
  1035.         }
  1036.         k = i % j;
  1037.         i = j;
  1038.         j = k;
  1039.         goto LL;
  1040.     }
  1041.  
  1042.     if (number_compare(x, y) < 0) {
  1043.         r = x;
  1044.         x = y;
  1045.         y = r;
  1046.     }
  1047.     if (type_of(y) == t_fixnum && fix(y) == 0) {
  1048.         vs_reset;
  1049.         return(x);
  1050.     }
  1051.     integer_quotient_remainder_1(x, y, &q, &r);
  1052.     vs_top[-2] = x = y;
  1053.     vs_top[-1] = y = r;
  1054.     goto L;
  1055. }
  1056.  
  1057. /* (+          )   */
  1058. Lplus()
  1059. {
  1060.         int i, j;
  1061.     
  1062.     j = vs_top - vs_base;
  1063.     if (j == 0) {
  1064.         vs_push(small_fixnum(0));
  1065.         return;
  1066.     }
  1067.     for (i = 0;  i < j;  i++)
  1068.         check_type_number(&vs_base[i]);
  1069.     for (i = 1;  i < j;  i++)
  1070.         vs_base[0] = number_plus(vs_base[0], vs_base[i]);
  1071.     vs_top = vs_base+1;
  1072. }
  1073.  
  1074. Lminus()
  1075. {
  1076.     int i, j;
  1077.  
  1078.     j = vs_top - vs_base;
  1079.     if (j == 0)
  1080.         too_few_arguments();
  1081.     for (i = 0; i < j ; i++)
  1082.         check_type_number(&vs_base[i]);
  1083.     if (j == 1) {
  1084.         vs_base[0] = number_negate(vs_base[0]);
  1085.         return;
  1086.     }
  1087.     for (i = 1;  i < j;  i++)
  1088.         vs_base[0] = number_minus(vs_base[0], vs_base[i]);
  1089.     vs_top = vs_base+1;
  1090. }
  1091.  
  1092. Ltimes()
  1093. {
  1094.     int i, j;
  1095.  
  1096.     j = vs_top - vs_base;
  1097.     if (j == 0) {
  1098.         vs_push(small_fixnum(1));
  1099.         return;
  1100.     }
  1101.     for (i = 0;  i < j;  i++)
  1102.         check_type_number(&vs_base[i]);
  1103.     for (i = 1;  i < j;  i++)
  1104.         vs_base[0] = number_times(vs_base[0], vs_base[i]);
  1105.     vs_top = vs_base+1;
  1106. }
  1107.  
  1108. Ldivide()
  1109. {
  1110.     int i, j;
  1111.  
  1112.     j = vs_top - vs_base;
  1113.     if (j == 0)
  1114.         too_few_arguments();
  1115.     for(i = 0;  i < j;  i++)
  1116.         check_type_number(&vs_base[i]);
  1117.     if (j == 1) {
  1118.         vs_base[0] = number_divide(small_fixnum(1), vs_base[0]);
  1119.         return;
  1120.     }
  1121.     for (i = 1; i < j; i++)
  1122.         vs_base[0] = number_divide(vs_base[0], vs_base[i]);
  1123.     vs_top = vs_base+1;
  1124. }
  1125.  
  1126. Lone_plus()
  1127. {
  1128.     object x;
  1129.     
  1130.     check_arg(1);
  1131.     check_type_number(&vs_base[0]);
  1132.     vs_base[0] = one_plus(vs_base[0]);
  1133. }
  1134.  
  1135. Lone_minus()
  1136. {
  1137.     object x;
  1138.     
  1139.     check_arg(1);
  1140.     check_type_number(&vs_base[0]);
  1141.     vs_base[0] = one_minus(vs_base[0]);
  1142. }
  1143.  
  1144. Lconjugate()
  1145. {
  1146.     object    c, i;
  1147.  
  1148.     check_arg(1);
  1149.     check_type_number(&vs_base[0]);
  1150.     c = vs_base[0];
  1151.     if (type_of(c) == t_complex) {
  1152.         i = number_negate(c->cmp.cmp_imag);
  1153.         vs_push(i);
  1154.         vs_base[0] = make_complex(c->cmp.cmp_real, i);
  1155.         vs_pop;
  1156.     }
  1157. }
  1158.  
  1159. Lgcd()
  1160. {
  1161.     int i, narg;
  1162.  
  1163.     narg = vs_top - vs_base;
  1164.     if (narg == 0) {
  1165.         vs_push(small_fixnum(0));
  1166.         return;
  1167.     }
  1168.     for (i = 0;  i < narg;  i++)
  1169.         check_type_integer(&vs_base[i]);
  1170.     if (narg == 1) {
  1171.         if (number_minusp(vs_base[0]))
  1172.             vs_base[0] = number_negate(vs_base[0]);
  1173.         return;
  1174.     }
  1175.     for (i = 1;  i < narg;  i++)
  1176.         vs_base[0] = get_gcd(vs_base[0], vs_base[i]);
  1177.     vs_top = vs_base+1;
  1178. }
  1179.  
  1180. Llcm()
  1181. {
  1182.     object t, g;
  1183.     int i, narg;
  1184.  
  1185.     narg = vs_top - vs_base;
  1186.     if (narg == 0)
  1187.         too_few_arguments();
  1188.     for (i = 0;  i < narg;  i++)
  1189.         check_type_integer(&vs_base[i]);
  1190.     if (narg == 1) {
  1191.         if (number_minusp(vs_base[0]))
  1192.             vs_base[0] = number_negate(vs_base[0]);
  1193.         return;
  1194.     }
  1195.     for (i = 1;  i < narg;  i++) {
  1196.         t = number_times(vs_base[0], vs_base[i]);
  1197.         vs_push(t);
  1198.         g = get_gcd(vs_base[0], vs_base[i]);
  1199.         vs_push(g);
  1200.         vs_base[0] = number_divide(t, g);
  1201.         vs_pop;
  1202.         vs_pop;
  1203.     }
  1204.     if (number_minusp(vs_base[0]))
  1205.         vs_base[0] = number_negate(vs_base[0]);
  1206.     vs_top = vs_base+1;
  1207. }
  1208.  
  1209. zero_divisor()
  1210. {
  1211.     FEerror("Zero divisor.", 0);
  1212. }
  1213.  
  1214. init_num_arith()
  1215. {
  1216.     make_function("+", Lplus);
  1217.     make_function("-", Lminus);
  1218.     make_function("*", Ltimes);
  1219.     make_function("/", Ldivide);
  1220.     make_function("1+", Lone_plus);
  1221.     make_function("1-", Lone_minus);
  1222.     make_function("CONJUGATE", Lconjugate);
  1223.     make_function("GCD", Lgcd);
  1224.     make_function("LCM", Llcm);
  1225. }
  1226.