misc.cpp.000

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