misc.cpp

   1 #include "stdafx.h"
   2 #include "defs.h"
   3 #include <string.h>
   4
   5 void
   6 new_string(char *s)
   7 {
   8         save();
   9         p1 = alloc();
  10         p1->k = STR;
  11         p1->u.str=(char *)malloc(strlen(s)+1);
  12         memcpy(p1->u.str,s,strlen(s)+1);
  13         push(p1);
  14         restore();
  15 }
  16
  17 void
  18 out_of_memory(void)
  19 {
  20         stop("out of memory");
  21 }
  22
  23 void
  24 push_zero_matrix(int i, int j)
  25 {
  26         push(alloc_tensor(i * j));
  27         stack[tos - 1]->u.tensor->ndim = 2;
  28         stack[tos - 1]->u.tensor->dim[0] = i;
  29         stack[tos - 1]->u.tensor->dim[1] = j;
  30 }
  31
  32 void
  33 push_identity_matrix(int n)
  34 {
  35         int i;
  36         push_zero_matrix(n, n);
  37         for (i = 0; i < n; i++)
  38                 stack[tos - 1]->u.tensor->elem[i * n + i] = one;
  39 }
  40
  41 void
  42 push_cars(U *p)
  43 {
  44         while (iscons(p)) {
  45                 push(car(p));
  46                 p = cdr(p);
  47         }
  48 }
  49
  50 void
  51 peek(void)
  52 {
  53         save();
  54         p1 = pop();
  55         push(p1);
  56         printline(p1);
  57         restore();
  58 }
  59
  60 void
  61 peek2(void)
  62 {
  63         print_lisp(stack[tos - 2]);
  64         print_lisp(stack[tos - 1]);
  65 }
  66
  67 int
  68 equal(U *p1, U *p2)
  69 {
  70         if (cmp_expr(p1, p2) == 0)
  71                 return 1;
  72         else
  73                 return 0;
  74 }
  75
  76 int
  77 lessp(U *p1, U *p2)
  78 {
  79         if (cmp_expr(p1, p2) < 0)
  80                 return 1;
  81         else
  82                 return 0;
  83 }
  84
  85 int
  86 sign(int n)
  87 {
  88         if (n < 0)
  89                 return -1;
  90         else if (n > 0)
  91                 return 1;
  92         else
  93                 return 0;
  94 }
  95
  96 int
  97 cmp_expr(U *p1, U *p2)
  98 {
  99         int n;
 100
 101         if (p1 == p2)
 102                 return 0;
 103
 104         if (p1 == symbol(NIL))
 105                 return -1;
 106
 107         if (p2 == symbol(NIL))
 108                 return 1;
 109
 110         if (isnum(p1) && isnum(p2))
 111                 return sign(compare_numbers(p1, p2));
 112
 113         if (isnum(p1))
 114                 return -1;
 115
 116         if (isnum(p2))
 117                 return 1;
 118
 119         if (isstr(p1) && isstr(p2))
 120                 return sign(strcmp(p1->u.str, p2->u.str));
 121
 122         if (isstr(p1))
 123                 return -1;
 124
 125         if (isstr(p2))
 126                 return 1;
 127
 128         if (issymbol(p1) && issymbol(p2))
 129                 return sign(strcmp(get_printname(p1), get_printname(p2)));
 130
 131         if (issymbol(p1))
 132                 return -1;
 133
 134         if (issymbol(p2))
 135                 return 1;
 136
 137         if (istensor(p1) && istensor(p2))
 138                 return compare_tensors(p1, p2);
 139
 140         if (istensor(p1))
 141                 return -1;
 142
 143         if (istensor(p2))
 144                 return 1;
 145
 146         while (iscons(p1) && iscons(p2)) {
 147                 n = cmp_expr(car(p1), car(p2));
 148                 if (n != 0)
 149                         return n;
 150                 p1 = cdr(p1);
 151                 p2 = cdr(p2);
 152         }
 153
 154         if (iscons(p2))
 155                 return -1;
 156
 157         if (iscons(p1))
 158                 return 1;
 159
 160         return 0;
 161 }
 162
 163 int
 164 length(U *p)
 165 {
 166         int n = 0;
 167         while (iscons(p)) {
 168                 p = cdr(p);
 169                 n++;
 170         }
 171         return n;
 172 }
 173
 174 static void unique_f(U *);
 175
 176 U *
 177 unique(U *p)
 178 {
 179         save();
 180         p1 = symbol(NIL);
 181         p2 = symbol(NIL);
 182         unique_f(p);
 183         if (p2 != symbol(NIL))
 184                 p1 = symbol(NIL);
 185         p = p1;
 186         restore();
 187         return p;
 188 }
 189
 190 static void
 191 unique_f(U *p)
 192 {
 193         if (isstr(p)) {
 194                 if (p1 == symbol(NIL))
 195                         p1 = p;
 196                 else if (p != p1)
 197                         p2 = p;
 198                 return;
 199         }
 200         while (iscons(p)) {
 201                 unique_f(car(p));
 202                 if (p2 != symbol(NIL))
 203                         return;
 204                 p = cdr(p);
 205         }
 206 }
 207
 208 #if 0
 209
 210 void
 211 check_endianess(void)
 212 {
 213         int tmp = 1;
 214         if (((char *) &tmp)[0] == 1 && Y_LITTLE_ENDIAN == 0) {
 215                 printf("Please change Y_LITTLE_ENDIAN to 1 in defs.h and recompile.");
 216                 Exit(1);
 217         }
 218         if (((char *) &tmp)[0] == 0 && Y_LITTLE_ENDIAN != 0) {
 219                 printf("Please change Y_LITTLE_ENDIAN to 0 in defs.h and recompile.");
 220                 Exit(1);
 221         }
 222 }
 223
 224 #endif
 225
 226 void
 227 ssqrt(void)
 228 {
 229         push_rational(1, 2);
 230         power();
 231 }
 232
 233 void
 234 yyexpand(void)
 235 {
 236         int x;
 237         x = expanding;
 238         expanding = 1;
 239         eval();
 240         expanding = x;
 241 }
 242
 243 void
 244 exponential(void)
 245 {
 246         push_symbol(E);
 247         swap();
 248         power();
 249 }
 250
 251 void
 252 square(void)
 253 {
 254         push_integer(2);
 255         power();
 256 }
 257
 258 static int
 259 __cmp(const void *p1, const void *p2)
 260 {
 261         return cmp_expr(*((U **) p1), *((U **) p2));
 262 }
 263
 264 void
 265 sort_stack(int n)
 266 {
 267         qsort(stack + tos - n, n, sizeof (U *), __cmp);
 268 }