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

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