imported 9.0.300

[ckermit.git] / ckuus3.c

diff --git a/ckuus3.c b/ckuus3.c
index f232159..5887b34 100644 (file)
--- a/ckuus3.c
+++ b/ckuus3.c
@@ -13,7 +13,7 @@
     Jeffrey E Altman <jaltman@secure-endpoints.com>
       Secure Endpoints Inc., New York City
 
-  Copyright (C) 1985, 2009,
+  Copyright (C) 1985, 2011,
     Trustees of Columbia University in the City of New York.
     All rights reserved.  See the C-Kermit COPYING.TXT file or the
     copyright text in the ckcmai.c module for disclaimer and permissions.
@@ -3389,7 +3389,7 @@ static struct keytab sexpops[] = {      /* Built-in operators */
     "eval",    SX_EVA, 0,               /* Assorted commands */
     "abs",     SX_ABS, SXF_ONE,
     "truncate",SX_TRU, SXF_ONE|SXF_FLO,
-    "round",   SX_ROU, SXF_ONE|SXF_FLO,
+    "round",   SX_ROU, SXF_ONE|SXF_TWO|SXF_FLO,
     "ceiling", SX_CEI, SXF_ONE|SXF_FLO,
     "floor",   SX_FLR, SXF_ONE|SXF_FLO,
     "float",   SX_FLO, SXF_ONE|SXF_FLO,
@@ -3428,6 +3428,7 @@ static int sexptrunc = 0;         /* Flag to force all results to int */
 #include <math.h>                       /* Floating-point functions */
 
 _PROTOTYP( char * fpformat, (CKFLOAT, int, int) );
+_PROTOTYP( CKFLOAT ckround, (CKFLOAT, int, char *, int) );
 
 extern char math_pi[];                  /* Value of Pi */
 extern int sexpecho;                    /* SET SEXPRESSION ECHO value */
@@ -3470,6 +3471,8 @@ sexpdebug(s) char * s; {
 
 /*  Returns value as string (empty, numeric, or non-numeric) */
 
+static char sxroundbuf[32];            /* For ROUND result */
+
 char *
 dosexp(s) char *s; {                    /* s = S-Expression */
     extern struct mtab *mactab;         /* Macro table */
@@ -3562,7 +3565,9 @@ dosexp(s) char *s; {                    /* s = S-Expression */
     }
     /* Break result up into "words" (an SEXP counts as a word) */
 
-    p[0] = NULL;                        /* (We don't use element 0) */
+    for (i = 0; i < SEXPMAX+1; i++ ) { /* Clear the operands */
+       p[i] = NULL;
+    }
     if (!*(s+1) || !*(s+2)) {           /* No need to call cksplit() */
         n = 1;                          /* if it's one or two chars. */
         p[1] = s;                       /* No need to malloc this either. */
@@ -3605,7 +3610,7 @@ dosexp(s) char *s; {                    /* s = S-Expression */
     debug(F110,sexpdebug("head"),p[1],0);
 
     if (n == 1 && p[1]) {
-        if (*(p[1]) == '\047') {
+        if (*(p[1]) == '\047') {       /* Apostrophe = LISP quote character */
             s2 = p[1];
             goto xdosexp;
         }
@@ -3817,7 +3822,7 @@ dosexp(s) char *s; {                    /* s = S-Expression */
                     }
                     break;
                   case SXF_ONE:
-                    if (n != 2) {
+                   if (n != 2) {
                         printf("?Too %s operands - \"%s\"\n",
                                (n > 2) ? "many" : "few", s);
                         sexprc++;
@@ -3836,6 +3841,44 @@ dosexp(s) char *s; {                    /* s = S-Expression */
             }
             if (kwflags & SXF_FLO)      /* Operator requires floating point */
               fpflag++;                 /* Force it */
+
+           if (x == SX_ROU) {          /* ROUND can have 1 or 2 arguments */
+               if (n < 2 || n > 3) {
+                   printf("?Too %s operands - \"%s\"\n",
+                          (n > 3) ? "many" : "few", s);
+                   sexprc++;
+                   goto xdosexp;
+               }
+           }
+           if (x == SX_ROU) {
+               /* But they are not "cumulative" like other SEXP args */
+               /* So this case is handled specially */
+               char buf1[32], buf2[32];
+               float r;
+               char * s0, * s1;
+               char * q0, * q1;
+
+               s0 = p[2];
+               if (!s0) s0 = "";
+               if (!*s0) s0 = "0";
+               q0 = dosexp(s0);
+               ckstrncpy(buf1,q0,32);
+               q0 = buf1;
+
+               s1 = p[3];
+               if (!s1) s1 = "";
+               if (!*s1) s1 = "0";
+               q1 = dosexp(s1);
+               if (!q1) q1 = "";
+               if (!*q1) q1 = "0";
+               ckstrncpy(buf2,q1,32);
+               q1 = buf2;
+
+               r = ckround(atof(q0),(int)(atof(q1)),sxroundbuf,31);
+               s2 = sxroundbuf;
+               sexprc = 0;
+               goto xdosexp;
+           }
         }
         if (x == SX_SET || x == SX_LET || /* Assignment is special */
             x == SX_INC || x == SX_DEC) {
@@ -4060,6 +4103,7 @@ dosexp(s) char *s; {                    /* s = S-Expression */
         quote = 0;
         s2 = p[i+1];                    /* Get operand */
         if (!s2) s2 = "";
+
 #ifdef COMMENT
         if (*s2 == '\047') {            /* Is it quoted? */
             debug(F110,sexpdebug("'B"),s2,0);
@@ -4173,7 +4217,7 @@ dosexp(s) char *s; {                    /* s = S-Expression */
            if ((x == SX_AND && result == 0) || /* Short circuit */
                (x == SX_LOR && result != 0))
              quit++;
-            if (!(kwflags & SXF_ONE))   /* Command with single arg */
+            if (!(kwflags & SXF_ONE))  /* Command w/single arg */
               continue;
         }
         if (x == SX_MOD || x == SX_DIV) {
@@ -4429,16 +4473,6 @@ dosexp(s) char *s; {                    /* s = S-Expression */
             truncate = 1;
             break;
 
-          case SX_ROU:                  /* Round */
-            if (fpj > 0.0)
-              fpj += 0.5;
-            else if (fpj < 0.0)
-              fpj -= 0.5;
-            fpresult = fpj;
-            fpflag = 1;
-            truncate = 1;
-            break;
-
           case SX_ABS:                  /* Absolute value */
             result = (j < 0) ? 0 - j : j;
 #ifdef FNFLOAT