home *** CD-ROM | disk | FTP | other *** search
/ Super Net 1 / SUPERNET_1.iso / PC / OTROS / MSDOS / WATTCP / DELFT / SAGE.TAR / sage / scheme / schbig.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-05-17  |  18.5 KB  |  706 lines

  1. /**********************************************************************
  2. ** MODULE INFORMATION*
  3. **********************
  4. **      FILE     NAME:       SCHBIG.C
  5. **      SYSTEM   NAME:       SCHEME
  6. **      ORIGINAL AUTHOR(S):  Alfred Kayser
  7. **      VERSION  NUMBER:     1.5.5
  8. **      CREATION DATE:       89/05/31
  9. **
  10. ** DESCRIPTION: This module contains functions to handle the
  11. **              Scheme numbers (except very large integers!)
  12. ***********************************************************************
  13. ** CHANGES INFORMATION **
  14. *************************
  15. ** REVISION:    $Revision:   1.0  $
  16. ** CHANGER:     $Author:   JAN  $
  17. ** WORKFILE:    $Workfile:   schnum.c  $
  18. ** LOGFILE:     $Logfile:   C:/CPROG/SCHEME/VCS/SCHNUM.C_V  $
  19. ** LOGINFO:     $Log:   C:/CPROG/SCHEME/VCS/SCHNUM.C_V  $
  20. **              
  21. **                 Rev 1.0   12 Oct 1989 11:46:16   JAN
  22. **              Initial revision.
  23. **********************************************************************/
  24. #include "schinc.h"
  25. #ifdef MSC
  26. #include <float.h>
  27. #endif
  28.  
  29. STATIC CELP BigOne;     /* This holds a big one */
  30. STATIC CELP ZERO;      /* This holds a zero */
  31.  
  32.  /***************** Prototype(s) for SCHNUM.C **************************/
  33.  
  34. STATIC CELP PASCAL Ds_maxmin  __((int n, CELP p,int t));
  35.  
  36. STATIC USHORT PASCAL DsMakeCopy __((CELP arg));
  37. STATIC CELP   PASCAL DsAddOne   __((CELP arg,int sign));
  38.  
  39. STATIC CELP CDECL Ds_max      __((int n, CELP args));
  40. STATIC CELP CDECL Ds_min      __((int n, CELP args));
  41. STATIC CELP CDECL Ds_plus     __((int n, CELP args));
  42. STATIC CELP CDECL Ds_mult     __((int n, CELP args));
  43. STATIC CELP CDECL Ds_minus    __((int n, CELP args));
  44. STATIC CELP CDECL Ds_div      __((int n, CELP args));
  45. STATIC CELP CDECL Ds_divide   __((CELP quo, CELP div));
  46. STATIC CELP CDECL Ds_rem      __((CELP p, CELP q));
  47. STATIC CELP CDECL Ds_mod      __((CELP p, CELP q));
  48. STATIC CELP CDECL Ds_quotient __((CELP p, CELP q));
  49. STATIC CELP CDECL Ds_is       __((CELP p, CELP q));
  50. STATIC CELP CDECL Ds_le       __((CELP p, CELP q));
  51. STATIC CELP CDECL Ds_lt       __((CELP p, CELP q));
  52. STATIC CELP CDECL Ds_ge       __((CELP p, CELP q));
  53. STATIC CELP CDECL Ds_gt       __((CELP p, CELP q));
  54. STATIC CELP CDECL Ds_zero     __((CELP arg));
  55. STATIC CELP CDECL Ds_posi     __((CELP arg));
  56. STATIC CELP CDECL Ds_floor    __((CELP arg));
  57. STATIC CELP CDECL Ds_round    __((CELP arg));
  58. STATIC CELP CDECL Ds_nega     __((CELP arg));
  59. STATIC CELP CDECL Ds_even     __((CELP arg));
  60. STATIC CELP CDECL Ds_odd      __((CELP arg));
  61. STATIC CELP CDECL Ds_abs      __((CELP arg));
  62. STATIC CELP CDECL Ds_inc      __((CELP arg));
  63. STATIC CELP CDECL Ds_dec      __((CELP arg));
  64.  
  65. STATIC EXTDEF math_ext[] =
  66.     {
  67.         {"+",               (EXTPROC)Ds_plus,     -1},
  68.         {"-",               (EXTPROC)Ds_minus,    -1},
  69.         {"*",               (EXTPROC)Ds_mult,     -1},
  70.         {"/",               (EXTPROC)Ds_div,      -1},
  71.         {"MAX",             (EXTPROC)Ds_max,      -1},
  72.         {"MIN",             (EXTPROC)Ds_min,      -1},
  73.         {"ZERO?",           (EXTPROC)Ds_zero,      1, 0},
  74.         {"EVEN?",           (EXTPROC)Ds_even,      1, 0},
  75.         {"ODD?",            (EXTPROC)Ds_odd,       1, 0},
  76.         {"NEGATIVE?",       (EXTPROC)Ds_nega,      1, 0},
  77.         {"POSITIVE?",       (EXTPROC)Ds_posi,      1, 0},
  78.         {"FLOOR",           (EXTPROC)Ds_floor,     1, 0},
  79.         {"ROUND",           (EXTPROC)Ds_round,     1, 0},
  80.         {"ABS",             (EXTPROC)Ds_abs,       1, 0},
  81.         {"INC",             (EXTPROC)Ds_inc,       1, 0},
  82.         {"DEC",             (EXTPROC)Ds_dec,       1, 0},
  83.         {"=",               (EXTPROC)Ds_is,        2, 0, 0},
  84.         {"<",               (EXTPROC)Ds_lt,        2, 0, 0},
  85.         {">",               (EXTPROC)Ds_gt,        2, 0, 0},
  86.         {">=",              (EXTPROC)Ds_ge,        2, 0, 0},
  87.         {"<=",              (EXTPROC)Ds_le,        2, 0, 0},
  88.         {"QUOTIENT",        (EXTPROC)Ds_quotient,  2, 0, 0},
  89.         {"REMAINDER",       (EXTPROC)Ds_rem,       2, 0, 0},
  90.         {"DIVIDE",          (EXTPROC)Ds_divide,    2, 0, 0},
  91.         ENDOFLIST
  92.     };
  93.  
  94. #ifdef MATHTRAP
  95. STATIC void CDECL DsMathError __((int sig,int fpe));
  96. #endif
  97.  
  98. /***************************************************************
  99. ** NAME:        DSmath                                     [API]
  100. ** SYNOPSIS:    int DSmath(glo)
  101. **              GLOBAL *glo;
  102. ** DESCRIPTION: This function initializes math system and links
  103. **              it to the DScheme environment.
  104. ** RETURNS:     S_ERROR, if error occured.
  105. **              S_OKAY otherwise.
  106. ***************************************************************/
  107. int PASCAL DSmath(glo)
  108. GLOBAL *glo;
  109. {
  110.     SETGLOB(glo,"DSmath");
  111.     if (setjmp(GLOB(err_jmp)))   /* If error somewhere in extdef jump to here */
  112.         return(DsRetCode());
  113.     GLOB(bignum)=TRUE;
  114.     DsFuncDef(math_ext);
  115.     BigOne=item=DsGetCell(TYPE_BIGP);
  116.     BIGpart(item)=1L;
  117.     CDRpart(item)=NIL;
  118.     DsDefVar(DsInsExt("*BIG-ONE*"));
  119.     ZERO=item=DSINTCEL(0L);
  120.     DsDefVar(DsInsExt("*ZERO*"));
  121. #ifdef MATHTRAP
  122.     if (signal(SIGFPE,DsMathError)==SIG_ERR)
  123.         return(S_ERROR);
  124. #endif
  125.     return(S_OKAY);
  126. }
  127.  
  128. #ifdef MATHTRAP
  129. /**************************************************************
  130. ** NAME:        DsMathError
  131. ** SYNOPSIS:    STATIC void DsMathError(sig,fpe)
  132. **              int sig,fpe;
  133. ** DESCRIPTION: Math error handle function. This function is
  134. **              raised by the SIG_FPE signal.
  135. ** RETURNS:     void
  136. **************************************************************/
  137. STATIC void CDECL DsMathError(sig,fpe)
  138. int sig,fpe;
  139. {
  140.     sig;
  141.     switch(fpe)
  142.     {
  143. #ifdef MSC
  144.     case FPE_ZERODIVIDE: DSERROR(ERRDIV0,item);
  145.     case FPE_OVERFLOW:   DSERROR(ERROVRFLW,item);
  146. #endif
  147.     default:             DSERROR(ERRFLOAT,item);
  148.     }
  149. }
  150. #endif
  151.               
  152.              
  153. STATIC
  154. USHORT PASCAL DsGetNTag(arg)
  155. CELP arg;
  156. {
  157.     TESTNUM(arg);
  158.     return(TAGpart(arg));
  159. }
  160.  
  161.  
  162. STATIC
  163. USHORT PASCAL DsMakeCopy(arg)
  164. CELP arg;
  165. {
  166.     USHORT tag;
  167.     TESTNUM(arg);
  168.     switch(tag=TAGpart(arg))
  169.     {
  170.     case TYPE_INT: item=DSINTCEL(INTpart(arg));break;
  171.     case TYPE_FLT: item=DSFLTCEL(FLTpart(arg));break;
  172.     default:       item=big_cpy(arg); break;
  173.     }
  174.     return tag;
  175. }
  176.  
  177.  
  178. STATIC
  179. CELP PASCAL DsAddOne(arg,sign)
  180. CELP arg;
  181. int sign;
  182. {
  183.     TESTNUM(arg);
  184.     switch(TAGpart(arg))
  185.     {
  186.     case TYPE_FLT: return DSFLTCEL(FLTpart(arg)+sign);
  187.     case TYPE_INT: item = int2big(arg); break;
  188.     default:       item = arg; break;
  189.     }
  190.     return big2int( sign==1 ? big_adds(item, BigOne)
  191.                             : big_subs(item, BigOne));
  192. }
  193.  
  194.  
  195. /***************************************************************
  196. ** NAME:        DsCmpNumber
  197. ** SYNOPSIS:    CELP DsCmpNumber(p,q,typ)
  198. **              CELP p,q;
  199. **              int typ;
  200. ** DESCRIPTION: Compares the numbers.
  201. **              t=0: test on equal
  202. **              t=-1: test on less or equal
  203. **              t=-2: test on less than
  204. **              t=1: test on greater or equal
  205. **              t=2: test on greator than
  206. ** RETURNS:     True when equal, false when different.
  207. ***************************************************************/
  208. #define int_cmp(a1,a2)  ((a1<a2)?-1:(a1==a2)?0:1)
  209.  
  210. CELP PASCAL DsCmpNumber(p,q,typ)
  211. CELP p,q;
  212. int typ;
  213. {
  214.     USHORT tagp,tagq;
  215.  
  216.     tagp=DsGetNTag(p);
  217.     tagq=DsGetNTag(q);
  218.     if (tagp==TYPE_FLT || tagq==TYPE_FLT)
  219.     {
  220.         switch(typ)
  221.         {
  222.         case -2: RETBOO(makeflo2(p,tagp)< makeflo2(q,tagq));
  223.         case -1: RETBOO(makeflo2(p,tagp)<=makeflo2(q,tagq));
  224.         case  0: RETBOO(makeflo2(p,tagp)==makeflo2(q,tagq));
  225.         case  1: RETBOO(makeflo2(p,tagp)>=makeflo2(q,tagq));
  226.         case  2: RETBOO(makeflo2(p,tagp)> makeflo2(q,tagq));
  227.         }
  228.     }
  229.     else
  230.     {
  231.         int val;
  232.         if (tagp==TYPE_INT)
  233.             val = (tagq==TYPE_INT)
  234.                 ? int_cmp(INTpart(p),INTpart(q))
  235.                 : big_cmp(makebig(p),q);
  236.         else
  237.             val = big_cmp(p,(tagq==TYPE_INT) ? makebig(q) : q);
  238.         switch(typ)
  239.         {
  240.         case -2: RETBOO (val< 0);
  241.         case -1: RETBOO (val<=0);
  242.         case  0: RETBOO (val==0);
  243.         case  1: RETBOO (val>=0);
  244.         case  2: RETBOO (val> 0);
  245.         }
  246.     }
  247.     return NIL;
  248. }
  249.  
  250.  
  251. /***************************************************************
  252. ** NAME:        Ds_maxmin
  253. ** SYNOPSIS:    CELP Ds_maxmin(n,q,t)
  254. **              int n;          number of arguments
  255. **              CELP q;         List of arguments
  256. **              int t;          t=2, return min, max otherwise
  257. ** DESCRIPTION: Returns the smallest or biggest argument.
  258. ** RETURNS:     The smallest(t=2) of the biggest(t=-2).
  259. ***************************************************************/
  260. STATIC CELP PASCAL Ds_maxmin(n,q,t)
  261. int n,t;
  262. CELP q;
  263. {
  264.     CELP res;
  265.     switch (n)
  266.     {
  267.     case 0: return NIL;
  268.     case 1: return q;
  269.     }
  270.     res=CARpart(q);
  271.     while (--n>1)                                 /* for each arg */
  272.     {
  273.         q=CDRpart(q);
  274.         if (DsCmpNumber(res, CARpart(q), t)==Q_true)
  275.             res=CARpart(q);
  276.     }
  277.     if (DsCmpNumber(res, CDRpart(q), t)==Q_true)
  278.         return CDRpart(q);
  279.     return res;
  280. }
  281.  
  282.  
  283. /*-------------------- Scheme Functions --------------------*/
  284.  
  285. STATIC
  286. CELP Ds_zero(arg)
  287. CELP arg;
  288. {
  289.     switch(DsGetNTag(arg))
  290.     {
  291.     case TYPE_INT: RETBOO (INTpart(arg)==0L);
  292.     case TYPE_FLT: RETBOO (FLTpart(arg)==0.0);
  293.     default: RETBOO( (INTpart(arg)==0L) && (ISNIL(CDRpart(arg))) );
  294.     }
  295. }
  296.  
  297.  
  298.  
  299. STATIC
  300. CELP Ds_posi(arg)
  301. CELP arg;
  302. {
  303.     switch(DsGetNTag(arg))
  304.     {
  305.     case TYPE_INT: RETBOO (INTpart(arg)>=0L);
  306.     case TYPE_FLT: RETBOO (FLTpart(arg)>=0.0);
  307.     case TYPE_BIGP: return Q_true;
  308.     default: return NIL;
  309.     }
  310. }
  311.  
  312.  
  313. STATIC
  314. CELP Ds_nega(arg)
  315. CELP arg;
  316. {
  317.     switch(DsGetNTag(arg))
  318.     {
  319.     case TYPE_INT: RETBOO (INTpart(arg)<0L);
  320.     case TYPE_FLT: RETBOO (FLTpart(arg)<=0.0);
  321.     case TYPE_BIGN: return Q_true;
  322.     default: return NIL;
  323.     }
  324. }
  325.  
  326.  
  327. STATIC 
  328. CELP Ds_floor(arg)
  329. CELP arg;
  330. {
  331.     if (DsGetNTag(arg)==TYPE_FLT)
  332.         return DSINTCEL((long)floor(FLTpart(arg)));
  333.     return arg;
  334. }
  335.  
  336.  
  337. STATIC 
  338. CELP Ds_round(arg)
  339. CELP arg;
  340. {
  341.     if (DsGetNTag(arg)==TYPE_FLT)
  342.         return DSINTCEL((long)floor(0.5+FLTpart(arg)));
  343.     return arg;
  344. }
  345.  
  346.  
  347. STATIC
  348. CELP Ds_rem(p,q)
  349. CELP p,q;
  350. {
  351.     p=big_divs(makebig(p), makebig(q), &q);
  352.     return q;
  353. }
  354.  
  355.  
  356. STATIC
  357. CELP Ds_quotient(p,q)
  358. CELP p,q;
  359. {
  360.     return big_divs(makebig(p), makebig(q), &q);
  361. }
  362.  
  363.      
  364. STATIC
  365. CELP Ds_even(arg)
  366. CELP arg;
  367. {
  368.     if (DsGetNTag(arg)==TYPE_FLT) DSTERROR(arg);
  369.     RETBOO (!(INTpart(arg)&1));
  370. }
  371.  
  372.  
  373. STATIC
  374. CELP Ds_odd(arg)
  375. CELP arg;
  376. {
  377.     if (DsGetNTag(arg)==TYPE_FLT) DSTERROR(arg);
  378.     RETBOO (INTpart(arg)&1);
  379. }
  380.  
  381.  
  382. STATIC
  383. CELP Ds_is(p,q)
  384. CELP p,q;
  385. {
  386.     return DsCmpNumber(p,q,0);
  387. }
  388.  
  389.  
  390. STATIC
  391. CELP Ds_le(p,q)
  392. CELP p,q;
  393. {
  394.     return DsCmpNumber(p,q,-1);
  395. }
  396.  
  397.  
  398. STATIC
  399. CELP Ds_lt(p,q)
  400. CELP p,q;
  401. {
  402.     return DsCmpNumber(p,q,-2);
  403. }
  404.  
  405. STATIC
  406. CELP Ds_ge(p,q)
  407. CELP p,q;
  408. {
  409.     return DsCmpNumber(p,q,1);
  410. }
  411.  
  412. STATIC
  413. CELP Ds_gt(p,q)
  414. CELP p,q;
  415. {
  416.     return DsCmpNumber(p,q,2);
  417. }
  418.  
  419.  
  420. STATIC
  421. CELP Ds_abs(arg)
  422. CELP arg;
  423. {
  424.     switch (DsMakeCopy(arg))
  425.     {
  426.     case TYPE_FLT: FLTpart(item)=fabs(FLTpart(item));break;
  427.     case TYPE_INT: INTpart(item)=labs(INTpart(item));break;
  428.     default:       TAGpart(item)=TYPE_BIGP;break;
  429.     }
  430.     return item;
  431. }
  432.  
  433.  
  434. STATIC
  435. CELP Ds_dec(arg)
  436. CELP arg;
  437. {       
  438.     return DsAddOne(arg,-1);
  439. }
  440.  
  441.  
  442. STATIC
  443. CELP Ds_inc(arg)
  444. CELP arg;
  445. {
  446.     return DsAddOne(arg,1);
  447. }
  448.  
  449.  
  450. /***************************************************************
  451. ** NAME:        Ds_plus
  452. ** SYNOPSIS:    CELP Ds_plus(n)
  453. **              int n;          Number of arguments
  454. ** DESCRIPTION: Calculates the sum of all the list elements.
  455. **              If all the list elements are integers, an
  456. **              integer result is returned, otherwise an
  457. **              floating point cel is returned.
  458. ** EXAMPLE:     (+ 2 3 4 5)                 = 14
  459. **              (+ 4 76.5 6)                = 86.5
  460. ** RETURNS:     The sum of all the elements
  461. ***************************************************************/
  462. STATIC
  463. CELP Ds_plus(n,args)
  464. int n;
  465. CELP args;
  466. {
  467.     CELP q;
  468.     USHORT res_typ;
  469.     REAL fresult;
  470.  
  471.     if (n==0) return ZERO;
  472.     if (n==1) return args;                    /* One argument: just return it */
  473.     switch(res_typ=DsGetNTag(item=CARpart(args)))
  474.     {
  475.     case TYPE_FLT: fresult=FLTpart(item); break;
  476.     case TYPE_INT: item=int2big(item); break;
  477.     }
  478.     while (--n)                                          /* for each arg left */
  479.     {
  480.         args=CDRpart(args);
  481.         q=(n==1)?args:CARpart(args);       
  482.         if (res_typ==TYPE_FLT)
  483.             fresult += makeflo2(q,DsGetNTag(q));
  484.         else
  485.         {
  486.             switch(DsGetNTag(q))
  487.             {
  488.             case TYPE_FLT: fresult = big2real(item) + FLTpart(q);
  489.                            res_typ = TYPE_FLT;break;
  490.             case TYPE_INT: item = big_adds(item, int2big(q));break;
  491.             default:       item = big_adds(item, q);break;
  492.             }
  493.         }
  494.     }
  495.     if (res_typ!=TYPE_FLT)
  496.         return big2int(item);
  497.     return DSFLTCEL(fresult);
  498. }
  499.  
  500.  
  501. /***************************************************************
  502. ** NAME:        Ds_mult
  503. ** SYNOPSIS:    CELP Ds_mult(n)
  504. **              int n;          Number of arguments
  505. ** DESCRIPTION: Calculates the product of all the list elements.
  506. **              If all the list elements are integers, an
  507. **              integer result is returned, otherwise an
  508. **              floating point cel is returned.
  509. ** RETURNS:     The product of all the elements
  510. ***************************************************************/
  511. STATIC
  512. CELP Ds_mult(n,args)
  513. int n;
  514. CELP args;
  515. {
  516.     CELP   q;
  517.     REAL   fresult;
  518.     USHORT res_typ;
  519.  
  520.     if (n==0) return ZERO;
  521.     if (n==1) return args;
  522.     switch(res_typ=DsGetNTag(item=CARpart(args)))
  523.     {
  524.     case TYPE_FLT: fresult=FLTpart(item); break;
  525.     case TYPE_INT: item=int2big(item); break;
  526.     }
  527.     while (--n)            /* for each arg left*/
  528.     {
  529.         args=CDRpart(args);
  530.         q=(n==1)?args:CARpart(args);       
  531.         if (res_typ==TYPE_FLT)
  532.             fresult *= makeflo2(q,DsGetNTag(q));
  533.         else
  534.         {
  535.             switch(DsGetNTag(q))
  536.             {
  537.             case TYPE_FLT: fresult = big2real(item) * FLTpart(q);
  538.                            res_typ = TYPE_FLT; break;
  539.             case TYPE_INT: item = big_muls(item, int2big(q)); break;
  540.             default:       item = big_muls(item, q); break;
  541.             }
  542.         }
  543.     }
  544.     if (res_typ!=TYPE_FLT)
  545.         return big2int(item);
  546.     return DSFLTCEL(fresult);
  547. }
  548.  
  549.  
  550. /***************************************************************
  551. ** NAME:        Ds_minus
  552. ** SYNOPSIS:    CELP Ds_minus(n)
  553. **              int n;          Number of arguments
  554. ** DESCRIPTION: Substracts the sum of the all but first elements
  555. **              of the list from the first element. Except when
  556. **              the element contains one element, then this
  557. **              is negated and returned.
  558. **              If all the list elements are integers, an
  559. **              integer result is returned, otherwise an
  560. **              floating point cel is returned.
  561. ** EXAMPLE:     (- 10 9)                             = 1
  562. **              (- 1234.5)                           = -1234.5
  563. ** RETURNS:     The difference of all the elements.
  564. ***************************************************************/
  565. STATIC
  566. CELP Ds_minus(n,args)
  567. int n;
  568. CELP args;
  569. {
  570.     CELP   q;
  571.     REAL   fresult;
  572.     USHORT res_typ;
  573.  
  574.     if (n==0) return ZERO;
  575.     if (n==1)
  576.     {
  577.         switch (DsMakeCopy(args))
  578.         {
  579.         case TYPE_FLT: FLTpart(item)=-FLTpart(item);break;
  580.         case TYPE_INT: INTpart(item)=-INTpart(item);break;
  581.         default: TAGpart(item) ^= TYPE_BIGN^TYPE_BIGP;break;
  582.         }
  583.     return item;
  584.     }
  585.     switch(res_typ=DsGetNTag(item=CARpart(args)))        /* first arg of more */
  586.     {
  587.     case TYPE_FLT: fresult=FLTpart(item); break;
  588.     case TYPE_INT: item=int2big(item); break;
  589.     }
  590.     while (--n)
  591.     {
  592.         args=CDRpart(args);
  593.         q=(n==1)?args:CARpart(args);
  594.         if (res_typ==TYPE_FLT)
  595.             fresult -= makeflo2(q, DsGetNTag(q));
  596.         else
  597.         {
  598.             switch(DsGetNTag(q))
  599.             {
  600.             case TYPE_FLT: res_typ = TYPE_FLT;
  601.                            fresult = big2real(item) - FLTpart(q);break;
  602.             case TYPE_INT: item = big_subs(item,int2big(q));break;
  603.             default:       item = big_subs(item,q);break;
  604.             }
  605.         }
  606.     }
  607.     if (res_typ!=TYPE_FLT)
  608.         return big2int(item);
  609.     return DSFLTCEL(fresult);
  610. }
  611.  
  612.  
  613. /***************************************************************
  614. ** NAME:        Ds_div
  615. ** SYNOPSIS:    CELP Ds_div(n)
  616. **              int n;          Number of arguments
  617. ** DESCRIPTION: Divides the arguments. (divide and conquer!)
  618. ** RETURNS:     The result.
  619. ***************************************************************/
  620. STATIC
  621. CELP Ds_div(n,args)
  622. int n;
  623. CELP args;
  624. {
  625.     CELP q,rem;
  626.     USHORT res_typ;
  627.     REAL fresult;
  628.  
  629.     if (n==0) return ZERO;
  630.     if (n==1)
  631.     {
  632.         switch(DsGetNTag(args))
  633.         {
  634.         case TYPE_FLT: ZEROCHECK(args); return DSFLTCEL(1.0/FLTpart(args));
  635.         case TYPE_INT: return big_divs(BigOne,int2big(args),&rem);
  636.         default:       return big_divs(BigOne,args,&rem);
  637.         }
  638.     }
  639.     switch(res_typ=DsGetNTag(item=CARpart(args)))
  640.     {
  641.     case TYPE_FLT: fresult=FLTpart(item); break;
  642.     case TYPE_INT: item=int2big(item); break;
  643.     }
  644.     while (--n)
  645.     {
  646.         args=CDRpart(args);
  647.         q=(n==1)?args:CARpart(args);
  648.         if (res_typ!=TYPE_FLT)
  649.         {
  650.             rem=NIL;
  651.             switch(DsGetNTag(q))
  652.             {
  653.             case TYPE_FLT: res_typ=TYPE_FLT; ZEROCHECK(q);
  654.                            fresult = big2real(item) / FLTpart(q);break;
  655.             case TYPE_INT: item = big_divs(item,int2big(q),&rem);break;
  656.             default:       item = big_divs(item,q,&rem);break;
  657.             }
  658.             if (rem) big_free(rem);
  659.         }
  660.         else
  661.         {
  662.             REAL tmp=makeflo2(q,DsGetNTag(q));
  663.             ZEROCHECK(tmp);
  664.             fresult /= tmp;
  665.         }
  666.     }
  667.     if (res_typ!=TYPE_FLT)
  668.         return big2int(item);
  669.     return DSFLTCEL(fresult);
  670. }
  671.  
  672.  
  673. /***************************************************************
  674. ** NAME:        Ds_divide
  675. ** SYNOPSIS:    CELP Ds_divide(quo,div)
  676. **              CELP quo,div;   dividend and divider.
  677. ** DESCRIPTION: Divides the first argument by the second.
  678. **              And returns both quotient and remainder.
  679. **              Works only on integers (long).
  680. ** EXAMPLE:     (/ 13 4)      = (3 . 1)
  681. ** RETURNS:     A pair with the quotient and the remainder
  682. ***************************************************************/
  683. STATIC
  684. CELP Ds_divide(a, b)
  685. CELP a;
  686. CELP b;
  687. {
  688.     a=big_divs(makebig(a), makebig(b), &b);
  689.     return(DsCons(big2int(a),big2int(b)));
  690. }
  691.  
  692.  
  693. STATIC CELP Ds_max(n,p)
  694. int n;
  695. CELP p;
  696. {
  697.     return Ds_maxmin(n,p,-2);
  698. }
  699.  
  700. STATIC CELP Ds_min(n,p)
  701. int n;
  702. CELP p;
  703. {
  704.     return Ds_maxmin(n,p,2);
  705. }
  706.