test.cpp

   1 // If the number of args is odd then the last arg is the default result.
   2
   3 #include "stdafx.h"
   4 #include "defs.h"
   5
   6 void
   7 eval_test(void)
   8 {
   9         p1 = cdr(p1);
  10         while (iscons(p1)) {
  11                 if (cdr(p1) == symbol(NIL)) {
  12                         push(car(p1)); // default case
  13                         eval();
  14                         return;
  15                 }
  16                 push(car(p1));
  17                 eval_predicate();
  18                 p2 = pop();
  19                 if (!iszero(p2)) {
  20                         push(cadr(p1));
  21                         eval();
  22                         return;
  23                 }
  24                 p1 = cddr(p1);
  25         }
  26         push_integer(0);
  27 }
  28
  29 // The test for equality is weaker than the other relational operators.
  30
  31 // For example, A<=B causes a stop when the result of A minus B is not a
  32 // numerical value.
  33
  34 // However, A==B never causes a stop.
  35
  36 // For A==B, any nonzero result for A minus B indicates inequality.
  37
  38 void
  39 eval_testeq(void)
  40 {
  41         push(cadr(p1));
  42         eval();
  43         push(caddr(p1));
  44         eval();
  45         subtract();
  46         p1 = pop();
  47         if (iszero(p1))
  48                 push_integer(1);
  49         else
  50                 push_integer(0);
  51 }
  52
  53 // Relational operators expect a numeric result for operand difference.
  54
  55 void
  56 eval_testge(void)
  57 {
  58         if (cmp_args() >= 0)
  59                 push_integer(1);
  60         else
  61                 push_integer(0);
  62 }
  63
  64 void
  65 eval_testgt(void)
  66 {
  67         if (cmp_args() > 0)
  68                 push_integer(1);
  69         else
  70                 push_integer(0);
  71 }
  72
  73 void
  74 eval_testle(void)
  75 {
  76         if (cmp_args() <= 0)
  77                 push_integer(1);
  78         else
  79                 push_integer(0);
  80 }
  81
  82 void
  83 eval_testlt(void)
  84 {
  85         if (cmp_args() < 0)
  86                 push_integer(1);
  87         else
  88                 push_integer(0);
  89 }
  90
  91 void
  92 eval_not(void)
  93 {
  94         push(cadr(p1));
  95         eval_predicate();
  96         p1 = pop();
  97         if (iszero(p1))
  98                 push_integer(1);
  99         else
 100                 push_integer(0);
 101 }
 102
 103 void
 104 eval_and(void)
 105 {
 106         p1 = cdr(p1);
 107         while (iscons(p1)) {
 108                 push(car(p1));
 109                 eval_predicate();
 110                 p2 = pop();
 111                 if (iszero(p2)) {
 112                         push_integer(0);
 113                         return;
 114                 }
 115                 p1 = cdr(p1);
 116         }
 117         push_integer(1);
 118 }
 119
 120 void
 121 eval_or(void)
 122 {
 123         p1 = cdr(p1);
 124         while (iscons(p1)) {
 125                 push(car(p1));
 126                 eval_predicate();
 127                 p2 = pop();
 128                 if (!iszero(p2)) {
 129                         push_integer(1);
 130                         return;
 131                 }
 132                 p1 = cdr(p1);
 133         }
 134         push_integer(0);
 135 }
 136
 137 // use subtract for cases like A < A + 1
 138
 139 int
 140 cmp_args(void)
 141 {
 142         int t;
 143
 144         push(cadr(p1));
 145         eval();
 146         push(caddr(p1));
 147         eval();
 148         subtract();
 149         p1 = pop();
 150
 151         // try floating point if necessary
 152
 153         if (p1->k != NUM && p1->k != DOUBLE) {
 154                 push(p1);
 155                 yyfloat();
 156                 eval();
 157                 p1 = pop();
 158         }
 159
 160         if (iszero(p1))
 161                 return 0;
 162
 163         switch (p1->k) {
 164         case NUM:
 165                 if (MSIGN(p1->u.q.a) == -1)
 166                         t = -1;
 167                 else
 168                         t = 1;
 169                 break;
 170         case DOUBLE:
 171                 if (p1->u.d < 0.0)
 172                         t = -1;
 173                 else
 174                         t = 1;
 175                 break;
 176         default:
 177                 stop("relational operator: cannot determine due to non-numerical comparison");
 178                 t = 0;
 179         }
 180
 181         return t;
 182 }