Takehisa Oneta / Mbed 2 deprecated malisp

Lisp Interpreter for mbed LPC1768

Dependencies:   mbed

Lisp Interpreter

(Marc Adler Lisp Interpreter, malisp)

mbed LPC1768 port by Takehisa Oneta (ohneta@gmail.com)

malisp.cpp@0:e9a7a38d9ad3, 2016-04-17 (annotated)

Committer:
ohneta
Date:
Sun Apr 17 11:59:13 2016 +0000
Revision:
0:e9a7a38d9ad3
Child:
1:a2955606adef
???????????

Who changed what in which revision?

UserRevisionLine numberNew contents of line
ohneta 0:e9a7a38d9ad3 1 #include "mbed.h"
ohneta 0:e9a7a38d9ad3 2
ohneta 0:e9a7a38d9ad3 3 #include <stdio.h>
ohneta 0:e9a7a38d9ad3 4 #include <stdlib.h>
ohneta 0:e9a7a38d9ad3 5 #include <ctype.h>
ohneta 0:e9a7a38d9ad3 6 #include <string.h>
ohneta 0:e9a7a38d9ad3 7 #include "malisp.h"
ohneta 0:e9a7a38d9ad3 8 #include "mbed_functions.h"
ohneta 0:e9a7a38d9ad3 9
ohneta 0:e9a7a38d9ad3 10 extern Serial pc;
ohneta 0:e9a7a38d9ad3 11 extern DigitalOut led1;
ohneta 0:e9a7a38d9ad3 12 extern DigitalOut led2;
ohneta 0:e9a7a38d9ad3 13 extern DigitalOut led3;
ohneta 0:e9a7a38d9ad3 14 extern DigitalOut led4;
ohneta 0:e9a7a38d9ad3 15 extern char *lisplib;
ohneta 0:e9a7a38d9ad3 16
ohneta 0:e9a7a38d9ad3 17 int _stack = 5000;
ohneta 0:e9a7a38d9ad3 18
ohneta 0:e9a7a38d9ad3 19 LIST *TRU;
ohneta 0:e9a7a38d9ad3 20 LIST *g_alist; // 連想リスト
ohneta 0:e9a7a38d9ad3 21 LIST *g_oblist; // list of Lisp Functions
ohneta 0:e9a7a38d9ad3 22
ohneta 0:e9a7a38d9ad3 23 char progon;
ohneta 0:e9a7a38d9ad3 24
ohneta 0:e9a7a38d9ad3 25 //FILE *fd; // input file descriptor
ohneta 0:e9a7a38d9ad3 26 FILE_MINE fd;
ohneta 0:e9a7a38d9ad3 27
ohneta 0:e9a7a38d9ad3 28 int32_t getc_mine_buffer_pt = 0;
ohneta 0:e9a7a38d9ad3 29 int getc_mine_buffer[8];
ohneta 0:e9a7a38d9ad3 30 uint32_t lisplib_counter = 0;
ohneta 0:e9a7a38d9ad3 31
ohneta 0:e9a7a38d9ad3 32 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 33 //int getc_mine(FILE *fd)
ohneta 0:e9a7a38d9ad3 34 int getc_mine(FILE_MINE fd)
ohneta 0:e9a7a38d9ad3 35 {
ohneta 0:e9a7a38d9ad3 36 if (getc_mine_buffer_pt > 0) {
ohneta 0:e9a7a38d9ad3 37 int c = getc_mine_buffer[getc_mine_buffer_pt];
ohneta 0:e9a7a38d9ad3 38 getc_mine_buffer_pt--;
ohneta 0:e9a7a38d9ad3 39 if (getc_mine_buffer_pt < 0) {
ohneta 0:e9a7a38d9ad3 40 getc_mine_buffer_pt = 0;
ohneta 0:e9a7a38d9ad3 41 }
ohneta 0:e9a7a38d9ad3 42 return c;
ohneta 0:e9a7a38d9ad3 43 }
ohneta 0:e9a7a38d9ad3 44
ohneta 0:e9a7a38d9ad3 45 //return getc(fd);
ohneta 0:e9a7a38d9ad3 46
ohneta 0:e9a7a38d9ad3 47 int c = 0;
ohneta 0:e9a7a38d9ad3 48 if (fd == FILE_SERIAL) {
ohneta 0:e9a7a38d9ad3 49 c = pc.getc();
ohneta 0:e9a7a38d9ad3 50 //pc.putc(c);
ohneta 0:e9a7a38d9ad3 51
ohneta 0:e9a7a38d9ad3 52 } else if (fd == FILE_STRING) {
ohneta 0:e9a7a38d9ad3 53
ohneta 0:e9a7a38d9ad3 54 if (lisplib_counter > strlen(lisplib)) {
ohneta 0:e9a7a38d9ad3 55 c = EOF; // EOF
ohneta 0:e9a7a38d9ad3 56 } else {
ohneta 0:e9a7a38d9ad3 57 c = *(lisplib + lisplib_counter);
ohneta 0:e9a7a38d9ad3 58 lisplib_counter++;
ohneta 0:e9a7a38d9ad3 59 }
ohneta 0:e9a7a38d9ad3 60 }
ohneta 0:e9a7a38d9ad3 61
ohneta 0:e9a7a38d9ad3 62 return c;
ohneta 0:e9a7a38d9ad3 63 }
ohneta 0:e9a7a38d9ad3 64
ohneta 0:e9a7a38d9ad3 65 //void ungetc_mine(int c, FILE *fd)
ohneta 0:e9a7a38d9ad3 66 void ungetc_mine(int c, FILE_MINE fd)
ohneta 0:e9a7a38d9ad3 67 {
ohneta 0:e9a7a38d9ad3 68 getc_mine_buffer_pt++;
ohneta 0:e9a7a38d9ad3 69 getc_mine_buffer[getc_mine_buffer_pt] = c;
ohneta 0:e9a7a38d9ad3 70 }
ohneta 0:e9a7a38d9ad3 71
ohneta 0:e9a7a38d9ad3 72 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 73 // main program
ohneta 0:e9a7a38d9ad3 74 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 75
ohneta 0:e9a7a38d9ad3 76 void malisp_main()
ohneta 0:e9a7a38d9ad3 77 {
ohneta 0:e9a7a38d9ad3 78 initialize();
ohneta 0:e9a7a38d9ad3 79 pc.printf("\nMarc Adler's LISP Interpreter. (mbed port and expansion by ohneta)\n");
ohneta 0:e9a7a38d9ad3 80 load_library();
ohneta 0:e9a7a38d9ad3 81
ohneta 0:e9a7a38d9ad3 82 pc.printf("[FREE-MEM: %d bytes]\n", _getFreeMemorySize());
ohneta 0:e9a7a38d9ad3 83
ohneta 0:e9a7a38d9ad3 84 {
ohneta 0:e9a7a38d9ad3 85 fd = FILE_SERIAL;
ohneta 0:e9a7a38d9ad3 86 getc_mine_buffer_pt = 0;
ohneta 0:e9a7a38d9ad3 87 interpret_malisp();
ohneta 0:e9a7a38d9ad3 88 }
ohneta 0:e9a7a38d9ad3 89 }
ohneta 0:e9a7a38d9ad3 90
ohneta 0:e9a7a38d9ad3 91 void interpret_malisp()
ohneta 0:e9a7a38d9ad3 92 {
ohneta 0:e9a7a38d9ad3 93 LIST *p = NULL;
ohneta 0:e9a7a38d9ad3 94 LIST *q = NULL;
ohneta 0:e9a7a38d9ad3 95 int c;
ohneta 0:e9a7a38d9ad3 96
ohneta 0:e9a7a38d9ad3 97 while (EOF != (c = gettok())) {
ohneta 0:e9a7a38d9ad3 98 if (c == ERR) {
ohneta 0:e9a7a38d9ad3 99 continue;
ohneta 0:e9a7a38d9ad3 100 }
ohneta 0:e9a7a38d9ad3 101
ohneta 0:e9a7a38d9ad3 102 switch (c) {
ohneta 0:e9a7a38d9ad3 103 case LPAREN:
ohneta 0:e9a7a38d9ad3 104 getc_mine(fd); // span the paren
ohneta 0:e9a7a38d9ad3 105 q = makelist();
ohneta 0:e9a7a38d9ad3 106 p = eval(q, g_alist);
ohneta 0:e9a7a38d9ad3 107 break;
ohneta 0:e9a7a38d9ad3 108
ohneta 0:e9a7a38d9ad3 109 case LETTER:
ohneta 0:e9a7a38d9ad3 110 p = cdr(car(getid()));
ohneta 0:e9a7a38d9ad3 111 break;
ohneta 0:e9a7a38d9ad3 112 }
ohneta 0:e9a7a38d9ad3 113
ohneta 0:e9a7a38d9ad3 114 if (fd == FILE_SERIAL) {
ohneta 0:e9a7a38d9ad3 115 pc.printf("\n");
ohneta 0:e9a7a38d9ad3 116 pc.printf("value => ");
ohneta 0:e9a7a38d9ad3 117 if (p == NULL) {
ohneta 0:e9a7a38d9ad3 118 pc.printf("nil");
ohneta 0:e9a7a38d9ad3 119 } else {
ohneta 0:e9a7a38d9ad3 120 lisp_print(cons(p, NULL));
ohneta 0:e9a7a38d9ad3 121 //lisp_print(p);
ohneta 0:e9a7a38d9ad3 122 }
ohneta 0:e9a7a38d9ad3 123 pc.printf("\n");
ohneta 0:e9a7a38d9ad3 124 }
ohneta 0:e9a7a38d9ad3 125 }
ohneta 0:e9a7a38d9ad3 126 }
ohneta 0:e9a7a38d9ad3 127
ohneta 0:e9a7a38d9ad3 128 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 129 // initialization procedures
ohneta 0:e9a7a38d9ad3 130 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 131
ohneta 0:e9a7a38d9ad3 132 void initialize()
ohneta 0:e9a7a38d9ad3 133 {
ohneta 0:e9a7a38d9ad3 134 init("'", QUOTE);
ohneta 0:e9a7a38d9ad3 135 init("car", FCAR);
ohneta 0:e9a7a38d9ad3 136 init("cond", COND);
ohneta 0:e9a7a38d9ad3 137 init("cdr", FCDR);
ohneta 0:e9a7a38d9ad3 138 init("defun", DEFUN);
ohneta 0:e9a7a38d9ad3 139 init("cons",FCONS);
ohneta 0:e9a7a38d9ad3 140 init("nil", NILL);
ohneta 0:e9a7a38d9ad3 141 init("atom",FATOM);
ohneta 0:e9a7a38d9ad3 142 init("prog",PROG);
ohneta 0:e9a7a38d9ad3 143 init("eq", FEQ);
ohneta 0:e9a7a38d9ad3 144 init("go", GO);
ohneta 0:e9a7a38d9ad3 145 init("setq",FSETQ);
ohneta 0:e9a7a38d9ad3 146 init("return",RETRN);
ohneta 0:e9a7a38d9ad3 147 init("print",PRINT);
ohneta 0:e9a7a38d9ad3 148 init("read", FREAD);
ohneta 0:e9a7a38d9ad3 149 init("rplaca",FREPLACA);
ohneta 0:e9a7a38d9ad3 150 init("rplacd",FREPLACD);
ohneta 0:e9a7a38d9ad3 151 init("apply", FAPPLY);
ohneta 0:e9a7a38d9ad3 152 init("eval", FEVAL);
ohneta 0:e9a7a38d9ad3 153 init("and", FAND);
ohneta 0:e9a7a38d9ad3 154 init("or", FOR);
ohneta 0:e9a7a38d9ad3 155 init("not", FNOT);
ohneta 0:e9a7a38d9ad3 156 init("plus", PLUS);
ohneta 0:e9a7a38d9ad3 157 init("zerop", ZEROP);
ohneta 0:e9a7a38d9ad3 158 init("diff", DIFF);
ohneta 0:e9a7a38d9ad3 159 init("greaterp", GREATERP);
ohneta 0:e9a7a38d9ad3 160 init("times", TIMES);
ohneta 0:e9a7a38d9ad3 161 init("lessp", LESSP);
ohneta 0:e9a7a38d9ad3 162 init("add1", ADD1);
ohneta 0:e9a7a38d9ad3 163 init("sub1", SUB1);
ohneta 0:e9a7a38d9ad3 164 init("quot", QUOTIENT);
ohneta 0:e9a7a38d9ad3 165 TRU = cons(init("t",T), NULL);
ohneta 0:e9a7a38d9ad3 166 init("numberp",NUMBERP);
ohneta 0:e9a7a38d9ad3 167 rplact(TRU, SATOM);
ohneta 0:e9a7a38d9ad3 168 init("null", NUL);
ohneta 0:e9a7a38d9ad3 169 init("funcall",FUNCALL);
ohneta 0:e9a7a38d9ad3 170
ohneta 0:e9a7a38d9ad3 171 // for mbed functions
ohneta 0:e9a7a38d9ad3 172 init("info", FINFO);
ohneta 0:e9a7a38d9ad3 173 init("freemem", FFREEMEM);
ohneta 0:e9a7a38d9ad3 174 init("wait", FWAIT);
ohneta 0:e9a7a38d9ad3 175 init("dout", FDOUT);
ohneta 0:e9a7a38d9ad3 176 init("din", FDIN);
ohneta 0:e9a7a38d9ad3 177 init("aout", FAOUT);
ohneta 0:e9a7a38d9ad3 178 init("ain", FAIN);
ohneta 0:e9a7a38d9ad3 179 init("pwmout", PWMOUT);
ohneta 0:e9a7a38d9ad3 180
ohneta 0:e9a7a38d9ad3 181 g_oblist = g_alist;
ohneta 0:e9a7a38d9ad3 182 }
ohneta 0:e9a7a38d9ad3 183
ohneta 0:e9a7a38d9ad3 184 LIST *init(char *name, int t)
ohneta 0:e9a7a38d9ad3 185 {
ohneta 0:e9a7a38d9ad3 186 LIST *p;
ohneta 0:e9a7a38d9ad3 187
ohneta 0:e9a7a38d9ad3 188 p = install(name, 1);
ohneta 0:e9a7a38d9ad3 189 rplact(p, t);
ohneta 0:e9a7a38d9ad3 190 return p;
ohneta 0:e9a7a38d9ad3 191 }
ohneta 0:e9a7a38d9ad3 192
ohneta 0:e9a7a38d9ad3 193 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 194 // create the executable list form of a LISP program
ohneta 0:e9a7a38d9ad3 195 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 196
ohneta 0:e9a7a38d9ad3 197 LIST *makelist()
ohneta 0:e9a7a38d9ad3 198 {
ohneta 0:e9a7a38d9ad3 199 LIST *p;
ohneta 0:e9a7a38d9ad3 200
ohneta 0:e9a7a38d9ad3 201 switch (gettok()) {
ohneta 0:e9a7a38d9ad3 202 case LPAREN:
ohneta 0:e9a7a38d9ad3 203 getc_mine(fd); // span the paren ?????
ohneta 0:e9a7a38d9ad3 204 p = makelist();
ohneta 0:e9a7a38d9ad3 205 p = cons(p, makelist());
ohneta 0:e9a7a38d9ad3 206 rplact(p, LST);
ohneta 0:e9a7a38d9ad3 207 return p;
ohneta 0:e9a7a38d9ad3 208
ohneta 0:e9a7a38d9ad3 209 case LETTER:
ohneta 0:e9a7a38d9ad3 210 p = getid();
ohneta 0:e9a7a38d9ad3 211 return cons(p, makelist());
ohneta 0:e9a7a38d9ad3 212
ohneta 0:e9a7a38d9ad3 213 case INQUOTE:
ohneta 0:e9a7a38d9ad3 214 p = getid();
ohneta 0:e9a7a38d9ad3 215 p = cons(p, makelist());
ohneta 0:e9a7a38d9ad3 216 rplaca(p, cons(car(p), cons(car(cdr(p)), NULL)));
ohneta 0:e9a7a38d9ad3 217 rplacd(p, cdr(cdr(p)));
ohneta 0:e9a7a38d9ad3 218 return p;
ohneta 0:e9a7a38d9ad3 219
ohneta 0:e9a7a38d9ad3 220 case DIGIT:
ohneta 0:e9a7a38d9ad3 221 p = getnum();
ohneta 0:e9a7a38d9ad3 222 return cons(p, makelist());
ohneta 0:e9a7a38d9ad3 223
ohneta 0:e9a7a38d9ad3 224 case RPAREN:
ohneta 0:e9a7a38d9ad3 225 getc_mine(fd); // span rparen ??????
ohneta 0:e9a7a38d9ad3 226 return NULL;
ohneta 0:e9a7a38d9ad3 227 }
ohneta 0:e9a7a38d9ad3 228
ohneta 0:e9a7a38d9ad3 229 return NULL;
ohneta 0:e9a7a38d9ad3 230 }
ohneta 0:e9a7a38d9ad3 231
ohneta 0:e9a7a38d9ad3 232
ohneta 0:e9a7a38d9ad3 233 // isp_print - walks along the list structure printing atoms
ohneta 0:e9a7a38d9ad3 234 void lisp_print(LIST *p)
ohneta 0:e9a7a38d9ad3 235 {
ohneta 0:e9a7a38d9ad3 236 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 237 if (type(p) == RATOM) {
ohneta 0:e9a7a38d9ad3 238 pc.printf("%f ", p->u.num);
ohneta 0:e9a7a38d9ad3 239 } else if (type(p) == IATOM) {
ohneta 0:e9a7a38d9ad3 240 pc.printf("%d ", (int) p->u.num);
ohneta 0:e9a7a38d9ad3 241 } else if (type(p) == SATOM) {
ohneta 0:e9a7a38d9ad3 242 pc.printf("%s ", getname(car(p)));
ohneta 0:e9a7a38d9ad3 243 } else if (type(car(p)) == LST) {
ohneta 0:e9a7a38d9ad3 244 pc.printf("%c", '(');
ohneta 0:e9a7a38d9ad3 245 lisp_print(car(p));
ohneta 0:e9a7a38d9ad3 246 pc.printf("%c", ')');
ohneta 0:e9a7a38d9ad3 247 lisp_print(cdr(p));
ohneta 0:e9a7a38d9ad3 248 } else if (type(p) == LST) {
ohneta 0:e9a7a38d9ad3 249 lisp_print(car(p));
ohneta 0:e9a7a38d9ad3 250 lisp_print(cdr(p));
ohneta 0:e9a7a38d9ad3 251 } else {
ohneta 0:e9a7a38d9ad3 252 pc.printf("******** can't print it out *******\n");
ohneta 0:e9a7a38d9ad3 253 }
ohneta 0:e9a7a38d9ad3 254 }
ohneta 0:e9a7a38d9ad3 255 }
ohneta 0:e9a7a38d9ad3 256
ohneta 0:e9a7a38d9ad3 257 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 258 // evaluate a LISP function
ohneta 0:e9a7a38d9ad3 259 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 260
ohneta 0:e9a7a38d9ad3 261 LIST *eval(LIST *x, LIST *alist)
ohneta 0:e9a7a38d9ad3 262 {
ohneta 0:e9a7a38d9ad3 263 LIST *p, *q;
ohneta 0:e9a7a38d9ad3 264 int savt, t;
ohneta 0:e9a7a38d9ad3 265
ohneta 0:e9a7a38d9ad3 266 if (x == NULL) {
ohneta 0:e9a7a38d9ad3 267 return NULL;
ohneta 0:e9a7a38d9ad3 268 }
ohneta 0:e9a7a38d9ad3 269 t = type(x);
ohneta 0:e9a7a38d9ad3 270 if (t == VARI) {
ohneta 0:e9a7a38d9ad3 271 return assoc(alist, getname(car(x)));
ohneta 0:e9a7a38d9ad3 272 }
ohneta 0:e9a7a38d9ad3 273 if (t == IATOM || t == RATOM) {
ohneta 0:e9a7a38d9ad3 274 return x;
ohneta 0:e9a7a38d9ad3 275 }
ohneta 0:e9a7a38d9ad3 276 if (t == LABL) {
ohneta 0:e9a7a38d9ad3 277 return NULL;
ohneta 0:e9a7a38d9ad3 278 }
ohneta 0:e9a7a38d9ad3 279
ohneta 0:e9a7a38d9ad3 280 switch (type(car(x))) {
ohneta 0:e9a7a38d9ad3 281 case T:
ohneta 0:e9a7a38d9ad3 282 return TRU;
ohneta 0:e9a7a38d9ad3 283
ohneta 0:e9a7a38d9ad3 284 case NILL:
ohneta 0:e9a7a38d9ad3 285 return NULL;
ohneta 0:e9a7a38d9ad3 286
ohneta 0:e9a7a38d9ad3 287 case QUOTE:
ohneta 0:e9a7a38d9ad3 288 var_to_atom(car(cdr(x)));
ohneta 0:e9a7a38d9ad3 289 return car(cdr(x));
ohneta 0:e9a7a38d9ad3 290
ohneta 0:e9a7a38d9ad3 291 case FCAR:
ohneta 0:e9a7a38d9ad3 292 return car(eval(cdr(x), alist));
ohneta 0:e9a7a38d9ad3 293
ohneta 0:e9a7a38d9ad3 294 case FCDR:
ohneta 0:e9a7a38d9ad3 295 return cdr(eval(cdr(x), alist));
ohneta 0:e9a7a38d9ad3 296
ohneta 0:e9a7a38d9ad3 297 case FATOM:
ohneta 0:e9a7a38d9ad3 298 return atom(eval(cdr(x), alist));
ohneta 0:e9a7a38d9ad3 299
ohneta 0:e9a7a38d9ad3 300 case FEQ:
ohneta 0:e9a7a38d9ad3 301 return eq(eval(car(cdr(x)),alist), eval(cdr(cdr(x)),alist));
ohneta 0:e9a7a38d9ad3 302
ohneta 0:e9a7a38d9ad3 303 case NUL:
ohneta 0:e9a7a38d9ad3 304 return eq(eval(car(cdr(x)), alist), NULL);
ohneta 0:e9a7a38d9ad3 305
ohneta 0:e9a7a38d9ad3 306 case FCONS:
ohneta 0:e9a7a38d9ad3 307 return cons(eval(car(cdr(x)),alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 308
ohneta 0:e9a7a38d9ad3 309 case FLIST:
ohneta 0:e9a7a38d9ad3 310 return _list(x);
ohneta 0:e9a7a38d9ad3 311
ohneta 0:e9a7a38d9ad3 312 case COND:
ohneta 0:e9a7a38d9ad3 313 return evalcond(cdr(x), alist);
ohneta 0:e9a7a38d9ad3 314
ohneta 0:e9a7a38d9ad3 315 case FSETQ:
ohneta 0:e9a7a38d9ad3 316 p = eval(cdr(cdr(x)), alist);
ohneta 0:e9a7a38d9ad3 317 rplacd(getvar(alist, getname(car(car(cdr(x))))), p);
ohneta 0:e9a7a38d9ad3 318 return p;
ohneta 0:e9a7a38d9ad3 319
ohneta 0:e9a7a38d9ad3 320 case DEFUN:
ohneta 0:e9a7a38d9ad3 321 rplact(car(car(cdr(x))), FUSER);
ohneta 0:e9a7a38d9ad3 322 rplacd(car(car(cdr(x))), cdr(cdr(x)));
ohneta 0:e9a7a38d9ad3 323 var_to_user(cdr(cdr(cdr(x))));
ohneta 0:e9a7a38d9ad3 324 if (fd == FILE_SERIAL) {
ohneta 0:e9a7a38d9ad3 325 pc.printf("%s\n", getname(car(car(cdr(x)))));
ohneta 0:e9a7a38d9ad3 326 }
ohneta 0:e9a7a38d9ad3 327 return NULL;
ohneta 0:e9a7a38d9ad3 328
ohneta 0:e9a7a38d9ad3 329 case FUSER:
ohneta 0:e9a7a38d9ad3 330 p = cdr(car(car(x))); // p is statement list
ohneta 0:e9a7a38d9ad3 331 return eval(car(cdr(p)), pairargs(car(p), evalargs(cdr(x),alist), alist, FALSE));
ohneta 0:e9a7a38d9ad3 332
ohneta 0:e9a7a38d9ad3 333 case FAPPLY:
ohneta 0:e9a7a38d9ad3 334 case FUNCALL:
ohneta 0:e9a7a38d9ad3 335 p = eval(car(cdr(x)), alist); // func name
ohneta 0:e9a7a38d9ad3 336 if (isfunc(savt = type(car(p)))) {
ohneta 0:e9a7a38d9ad3 337 p = cons(p, cdr(cdr(x)));
ohneta 0:e9a7a38d9ad3 338 if (savt == FUSER) {
ohneta 0:e9a7a38d9ad3 339 rplact(car(p), FUSER);
ohneta 0:e9a7a38d9ad3 340 }
ohneta 0:e9a7a38d9ad3 341 q = eval(p, alist);
ohneta 0:e9a7a38d9ad3 342 rplact(car(p), savt);
ohneta 0:e9a7a38d9ad3 343 return q;
ohneta 0:e9a7a38d9ad3 344 } else
ohneta 0:e9a7a38d9ad3 345 return NULL;
ohneta 0:e9a7a38d9ad3 346
ohneta 0:e9a7a38d9ad3 347 case FEVAL:
ohneta 0:e9a7a38d9ad3 348 p = eval(cdr(x), alist);
ohneta 0:e9a7a38d9ad3 349 if (type(p) == SATOM) {
ohneta 0:e9a7a38d9ad3 350 return assoc(alist, getname(car(p)));
ohneta 0:e9a7a38d9ad3 351 }
ohneta 0:e9a7a38d9ad3 352 return eval(p, alist);
ohneta 0:e9a7a38d9ad3 353
ohneta 0:e9a7a38d9ad3 354 case PRINT:
ohneta 0:e9a7a38d9ad3 355 lisp_print(eval(car(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 356 pc.printf("\n");
ohneta 0:e9a7a38d9ad3 357 return NULL;
ohneta 0:e9a7a38d9ad3 358
ohneta 0:e9a7a38d9ad3 359 case FREAD:
ohneta 0:e9a7a38d9ad3 360 return makelist();
ohneta 0:e9a7a38d9ad3 361
ohneta 0:e9a7a38d9ad3 362 case FAND:
ohneta 0:e9a7a38d9ad3 363 return _and(x);
ohneta 0:e9a7a38d9ad3 364 case FOR:
ohneta 0:e9a7a38d9ad3 365 return _or(x);
ohneta 0:e9a7a38d9ad3 366 case FNOT:
ohneta 0:e9a7a38d9ad3 367 return _not(x);
ohneta 0:e9a7a38d9ad3 368
ohneta 0:e9a7a38d9ad3 369 case PLUS:
ohneta 0:e9a7a38d9ad3 370 case DIFF:
ohneta 0:e9a7a38d9ad3 371 case TIMES:
ohneta 0:e9a7a38d9ad3 372 case QUOTIENT:
ohneta 0:e9a7a38d9ad3 373 case GREATERP:
ohneta 0:e9a7a38d9ad3 374 case LESSP:
ohneta 0:e9a7a38d9ad3 375 return arith(car(x), eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 376
ohneta 0:e9a7a38d9ad3 377 case ADD1:
ohneta 0:e9a7a38d9ad3 378 case SUB1:
ohneta 0:e9a7a38d9ad3 379 return arith(car(x), eval(car(cdr(x)), alist), NULL);
ohneta 0:e9a7a38d9ad3 380
ohneta 0:e9a7a38d9ad3 381 case ZEROP:
ohneta 0:e9a7a38d9ad3 382 p = eval(car(cdr(x)), alist);
ohneta 0:e9a7a38d9ad3 383 return (p->u.num == 0) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 384
ohneta 0:e9a7a38d9ad3 385 case NUMBERP:
ohneta 0:e9a7a38d9ad3 386 savt = type(eval(car(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 387 return (savt==IATOM || savt==RATOM) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 388
ohneta 0:e9a7a38d9ad3 389 case PROG:
ohneta 0:e9a7a38d9ad3 390 return evalprog(x, alist);
ohneta 0:e9a7a38d9ad3 391
ohneta 0:e9a7a38d9ad3 392 case GO:
ohneta 0:e9a7a38d9ad3 393 return cdr(car(car(cdr(x))));
ohneta 0:e9a7a38d9ad3 394
ohneta 0:e9a7a38d9ad3 395 case RETRN:
ohneta 0:e9a7a38d9ad3 396 progon = FALSE;
ohneta 0:e9a7a38d9ad3 397 return eval(cdr(x), alist);
ohneta 0:e9a7a38d9ad3 398
ohneta 0:e9a7a38d9ad3 399 case LST:
ohneta 0:e9a7a38d9ad3 400 if (cdr(x) == NULL) {
ohneta 0:e9a7a38d9ad3 401 return eval(car(x), alist);
ohneta 0:e9a7a38d9ad3 402 }
ohneta 0:e9a7a38d9ad3 403 return cons(eval(car(x),alist),eval(cdr(x),alist));
ohneta 0:e9a7a38d9ad3 404
ohneta 0:e9a7a38d9ad3 405 case VARI:
ohneta 0:e9a7a38d9ad3 406 return assoc(alist, getname(car(car(x))));
ohneta 0:e9a7a38d9ad3 407
ohneta 0:e9a7a38d9ad3 408 case IATOM:
ohneta 0:e9a7a38d9ad3 409 case RATOM:
ohneta 0:e9a7a38d9ad3 410 return car(x);
ohneta 0:e9a7a38d9ad3 411
ohneta 0:e9a7a38d9ad3 412
ohneta 0:e9a7a38d9ad3 413
ohneta 0:e9a7a38d9ad3 414 // mbed expand
ohneta 0:e9a7a38d9ad3 415 case FINFO:
ohneta 0:e9a7a38d9ad3 416 {
ohneta 0:e9a7a38d9ad3 417 /*
ohneta 0:e9a7a38d9ad3 418 pc.printf("alist --\n");
ohneta 0:e9a7a38d9ad3 419 work_garbageCollect(g_alist);
ohneta 0:e9a7a38d9ad3 420 pc.printf("oblist --\n");
ohneta 0:e9a7a38d9ad3 421 work_garbageCollect(g_oblist);
ohneta 0:e9a7a38d9ad3 422 */
ohneta 0:e9a7a38d9ad3 423 //pc.printf("alist --\n");
ohneta 0:e9a7a38d9ad3 424 //debug(g_alist);
ohneta 0:e9a7a38d9ad3 425 pc.printf("\noblist --\n");
ohneta 0:e9a7a38d9ad3 426 debug(g_oblist);
ohneta 0:e9a7a38d9ad3 427
ohneta 0:e9a7a38d9ad3 428 return NULL;
ohneta 0:e9a7a38d9ad3 429 }
ohneta 0:e9a7a38d9ad3 430 case FFREEMEM:
ohneta 0:e9a7a38d9ad3 431 {
ohneta 0:e9a7a38d9ad3 432 LIST * p = memfreesize();
ohneta 0:e9a7a38d9ad3 433 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 434 p->gcbit = GARBAGE;
ohneta 0:e9a7a38d9ad3 435 }
ohneta 0:e9a7a38d9ad3 436 return p;
ohneta 0:e9a7a38d9ad3 437 }
ohneta 0:e9a7a38d9ad3 438 case FWAIT:
ohneta 0:e9a7a38d9ad3 439 {
ohneta 0:e9a7a38d9ad3 440 LIST * p = mbed_wait(eval(car(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 441 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 442 p->gcbit = GARBAGE;
ohneta 0:e9a7a38d9ad3 443 }
ohneta 0:e9a7a38d9ad3 444 return p;
ohneta 0:e9a7a38d9ad3 445 }
ohneta 0:e9a7a38d9ad3 446 case FDOUT:
ohneta 0:e9a7a38d9ad3 447 return mbed_digitalout(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 448 case FDIN:
ohneta 0:e9a7a38d9ad3 449 return mbed_digitalin(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 450 case FAOUT:
ohneta 0:e9a7a38d9ad3 451 return mbed_analogout(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 452 case FAIN:
ohneta 0:e9a7a38d9ad3 453 return mbed_analogin(eval(car(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 454 case PWMOUT:
ohneta 0:e9a7a38d9ad3 455 return mbed_pwmout(eval(car(cdr(x)), alist), eval(car(cdr(cdr(x))), alist), eval(cdr(cdr(cdr(x))), alist));
ohneta 0:e9a7a38d9ad3 456 }
ohneta 0:e9a7a38d9ad3 457
ohneta 0:e9a7a38d9ad3 458 return NULL;
ohneta 0:e9a7a38d9ad3 459 }
ohneta 0:e9a7a38d9ad3 460
ohneta 0:e9a7a38d9ad3 461
ohneta 0:e9a7a38d9ad3 462 LIST *evalcond(LIST *expr, LIST *alist)
ohneta 0:e9a7a38d9ad3 463 {
ohneta 0:e9a7a38d9ad3 464 if (expr == NULL) {
ohneta 0:e9a7a38d9ad3 465 return NULL;
ohneta 0:e9a7a38d9ad3 466 }
ohneta 0:e9a7a38d9ad3 467
ohneta 0:e9a7a38d9ad3 468 if (eval(car(car(expr)), alist) != NULL) { // expr was true
ohneta 0:e9a7a38d9ad3 469 return eval(car(cdr(car(expr))), alist); // return result
ohneta 0:e9a7a38d9ad3 470 }
ohneta 0:e9a7a38d9ad3 471
ohneta 0:e9a7a38d9ad3 472 return evalcond(cdr(expr), alist); // eval rest of args
ohneta 0:e9a7a38d9ad3 473 }
ohneta 0:e9a7a38d9ad3 474
ohneta 0:e9a7a38d9ad3 475
ohneta 0:e9a7a38d9ad3 476 LIST *evalprog(LIST *p, LIST *alist)
ohneta 0:e9a7a38d9ad3 477 {
ohneta 0:e9a7a38d9ad3 478 LIST *x = NULL;
ohneta 0:e9a7a38d9ad3 479
ohneta 0:e9a7a38d9ad3 480 // set up parameters as locals
ohneta 0:e9a7a38d9ad3 481 alist = pairargs(car(cdr(p)), cons(NULL, NULL), alist, TRUE);
ohneta 0:e9a7a38d9ad3 482 progon = TRUE;
ohneta 0:e9a7a38d9ad3 483 p = cdr(cdr(p)); /* p now points to the statement list */
ohneta 0:e9a7a38d9ad3 484 find_labels(p); /* set up all labels in the prog */
ohneta 0:e9a7a38d9ad3 485
ohneta 0:e9a7a38d9ad3 486 while (p != NULL && progon) {
ohneta 0:e9a7a38d9ad3 487 x = eval(car(p), alist);
ohneta 0:e9a7a38d9ad3 488 if (type(car(car(p))) == GO) {
ohneta 0:e9a7a38d9ad3 489 p = x; /* GO returned the next statement to go to */
ohneta 0:e9a7a38d9ad3 490 } else {
ohneta 0:e9a7a38d9ad3 491 p = cdr(p); /* just follow regular chain of statements */
ohneta 0:e9a7a38d9ad3 492
ohneta 0:e9a7a38d9ad3 493 }
ohneta 0:e9a7a38d9ad3 494 }
ohneta 0:e9a7a38d9ad3 495
ohneta 0:e9a7a38d9ad3 496 progon = TRUE; /* in case of nested progs */
ohneta 0:e9a7a38d9ad3 497 return x;
ohneta 0:e9a7a38d9ad3 498 }
ohneta 0:e9a7a38d9ad3 499
ohneta 0:e9a7a38d9ad3 500 // pairargs - installs parameters in the alist, and sets the value to be the value of the corresponding argument.
ohneta 0:e9a7a38d9ad3 501 LIST *pairargs(LIST *params, LIST *args, LIST *alist, int prog)
ohneta 0:e9a7a38d9ad3 502 {
ohneta 0:e9a7a38d9ad3 503 if (params == NULL) { // no more args to be evaluated
ohneta 0:e9a7a38d9ad3 504 return alist;
ohneta 0:e9a7a38d9ad3 505 }
ohneta 0:e9a7a38d9ad3 506
ohneta 0:e9a7a38d9ad3 507 LIST *p = cons(NULL, car(args)); // value of param is corresponding arg
ohneta 0:e9a7a38d9ad3 508 p->u.pname = getname(car(car(params)));
ohneta 0:e9a7a38d9ad3 509 rplact(p, VARI);
ohneta 0:e9a7a38d9ad3 510 if (prog) {
ohneta 0:e9a7a38d9ad3 511 return cons(p, pairargs(cdr(params), cons(NULL,NULL), alist, prog));
ohneta 0:e9a7a38d9ad3 512 }
ohneta 0:e9a7a38d9ad3 513
ohneta 0:e9a7a38d9ad3 514 return cons(p, pairargs(cdr(params), cdr(args), alist, prog));
ohneta 0:e9a7a38d9ad3 515 }
ohneta 0:e9a7a38d9ad3 516
ohneta 0:e9a7a38d9ad3 517 LIST *evalargs(LIST *arglist, LIST *alist)
ohneta 0:e9a7a38d9ad3 518 {
ohneta 0:e9a7a38d9ad3 519 if (arglist == NULL) {
ohneta 0:e9a7a38d9ad3 520 return NULL;
ohneta 0:e9a7a38d9ad3 521 }
ohneta 0:e9a7a38d9ad3 522
ohneta 0:e9a7a38d9ad3 523 return cons(eval(car(arglist),alist), evalargs(cdr(arglist), alist));
ohneta 0:e9a7a38d9ad3 524 }
ohneta 0:e9a7a38d9ad3 525
ohneta 0:e9a7a38d9ad3 526 LIST *assoc( LIST *alist, char *name)
ohneta 0:e9a7a38d9ad3 527 {
ohneta 0:e9a7a38d9ad3 528 return cdr(getvar(alist, name));
ohneta 0:e9a7a38d9ad3 529 }
ohneta 0:e9a7a38d9ad3 530
ohneta 0:e9a7a38d9ad3 531 LIST *getvar(LIST *alist, char *name)
ohneta 0:e9a7a38d9ad3 532 {
ohneta 0:e9a7a38d9ad3 533 return lookup(alist, name);
ohneta 0:e9a7a38d9ad3 534 }
ohneta 0:e9a7a38d9ad3 535
ohneta 0:e9a7a38d9ad3 536 // arith - performs arithmetic on numeric items
ohneta 0:e9a7a38d9ad3 537 LIST *arith(LIST *op, LIST *x, LIST *y)
ohneta 0:e9a7a38d9ad3 538 {
ohneta 0:e9a7a38d9ad3 539 LIST *p;
ohneta 0:e9a7a38d9ad3 540 float res = 0;
ohneta 0:e9a7a38d9ad3 541 int t = type(op);
ohneta 0:e9a7a38d9ad3 542
ohneta 0:e9a7a38d9ad3 543 if (t == LESSP) {
ohneta 0:e9a7a38d9ad3 544 return (x->u.num < y->u.num) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 545 }
ohneta 0:e9a7a38d9ad3 546 if (t == GREATERP) {
ohneta 0:e9a7a38d9ad3 547 return (x->u.num > y->u.num) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 548 }
ohneta 0:e9a7a38d9ad3 549
ohneta 0:e9a7a38d9ad3 550 switch (t) {
ohneta 0:e9a7a38d9ad3 551 case PLUS:
ohneta 0:e9a7a38d9ad3 552 res = x->u.num + y->u.num;
ohneta 0:e9a7a38d9ad3 553 break;
ohneta 0:e9a7a38d9ad3 554 case DIFF:
ohneta 0:e9a7a38d9ad3 555 res = x->u.num - y->u.num;
ohneta 0:e9a7a38d9ad3 556 break;
ohneta 0:e9a7a38d9ad3 557 case TIMES:
ohneta 0:e9a7a38d9ad3 558 res = x->u.num * y->u.num;
ohneta 0:e9a7a38d9ad3 559 break;
ohneta 0:e9a7a38d9ad3 560 case QUOTIENT:
ohneta 0:e9a7a38d9ad3 561 res = x->u.num / y->u.num;
ohneta 0:e9a7a38d9ad3 562 break;
ohneta 0:e9a7a38d9ad3 563 case ADD1:
ohneta 0:e9a7a38d9ad3 564 res = x->u.num + 1;
ohneta 0:e9a7a38d9ad3 565 break;
ohneta 0:e9a7a38d9ad3 566 case SUB1:
ohneta 0:e9a7a38d9ad3 567 res = x->u.num - 1;
ohneta 0:e9a7a38d9ad3 568 break;
ohneta 0:e9a7a38d9ad3 569 }
ohneta 0:e9a7a38d9ad3 570
ohneta 0:e9a7a38d9ad3 571 p = cons(NULL, NULL);
ohneta 0:e9a7a38d9ad3 572
ohneta 0:e9a7a38d9ad3 573 // @TODO: tがADD1かSUB1の場合、yは必ずNULLなので、 type(y)を実行するとエラーだと思うんだが...
ohneta 0:e9a7a38d9ad3 574 /*
ohneta 0:e9a7a38d9ad3 575 if ( (type(x) == IATOM) &&
ohneta 0:e9a7a38d9ad3 576 (type(y) == IATOM) ||
ohneta 0:e9a7a38d9ad3 577 (t == ADD1) || (t == SUB1) )
ohneta 0:e9a7a38d9ad3 578 ) {
ohneta 0:e9a7a38d9ad3 579 */
ohneta 0:e9a7a38d9ad3 580 if ((type(x) == IATOM) && ((t == ADD1) || (t == SUB1))) {
ohneta 0:e9a7a38d9ad3 581 p->u.num = (int)res;
ohneta 0:e9a7a38d9ad3 582 rplact(p, IATOM);
ohneta 0:e9a7a38d9ad3 583 } else {
ohneta 0:e9a7a38d9ad3 584 p->u.num = res;
ohneta 0:e9a7a38d9ad3 585 rplact(p, RATOM);
ohneta 0:e9a7a38d9ad3 586 }
ohneta 0:e9a7a38d9ad3 587
ohneta 0:e9a7a38d9ad3 588 return p;
ohneta 0:e9a7a38d9ad3 589 }
ohneta 0:e9a7a38d9ad3 590
ohneta 0:e9a7a38d9ad3 591 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 592 // input functions
ohneta 0:e9a7a38d9ad3 593 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 594
ohneta 0:e9a7a38d9ad3 595 // advance - skips white space in input file
ohneta 0:e9a7a38d9ad3 596 int advance()
ohneta 0:e9a7a38d9ad3 597 {
ohneta 0:e9a7a38d9ad3 598 int c;
ohneta 0:e9a7a38d9ad3 599 #if 0
ohneta 0:e9a7a38d9ad3 600 while (((c = getc_mine(fd)) != EOF) && (strchr(" \t\n", c) != NULL));
ohneta 0:e9a7a38d9ad3 601 #else
ohneta 0:e9a7a38d9ad3 602 while (1) {
ohneta 0:e9a7a38d9ad3 603 c = getc_mine(fd);
ohneta 0:e9a7a38d9ad3 604 if (c == EOF) {
ohneta 0:e9a7a38d9ad3 605 break;
ohneta 0:e9a7a38d9ad3 606 }
ohneta 0:e9a7a38d9ad3 607 if (strchr(" \t\n\r", c) == NULL) {
ohneta 0:e9a7a38d9ad3 608 break;
ohneta 0:e9a7a38d9ad3 609 }
ohneta 0:e9a7a38d9ad3 610 }
ohneta 0:e9a7a38d9ad3 611 #endif
ohneta 0:e9a7a38d9ad3 612 ungetc_mine(c, fd);
ohneta 0:e9a7a38d9ad3 613 //pc.printf("%c", c);
ohneta 0:e9a7a38d9ad3 614
ohneta 0:e9a7a38d9ad3 615 return c;
ohneta 0:e9a7a38d9ad3 616 }
ohneta 0:e9a7a38d9ad3 617
ohneta 0:e9a7a38d9ad3 618 LIST *lookup(LIST *head, char *name)
ohneta 0:e9a7a38d9ad3 619 {
ohneta 0:e9a7a38d9ad3 620 LIST *p;
ohneta 0:e9a7a38d9ad3 621
ohneta 0:e9a7a38d9ad3 622 #if 0
ohneta 0:e9a7a38d9ad3 623 for (p = head; p != NULL && strcmp(name, getname(car(p))); p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 624 ;
ohneta 0:e9a7a38d9ad3 625 }
ohneta 0:e9a7a38d9ad3 626 #else
ohneta 0:e9a7a38d9ad3 627 p = head;
ohneta 0:e9a7a38d9ad3 628 while (p != NULL) {
ohneta 0:e9a7a38d9ad3 629 if (strcmp(name, getname(car(p))) == 0) {
ohneta 0:e9a7a38d9ad3 630 break;
ohneta 0:e9a7a38d9ad3 631 }
ohneta 0:e9a7a38d9ad3 632 p = cdr(p);
ohneta 0:e9a7a38d9ad3 633 }
ohneta 0:e9a7a38d9ad3 634 #endif
ohneta 0:e9a7a38d9ad3 635
ohneta 0:e9a7a38d9ad3 636 return ((p == NULL) ? NULL : car(p));
ohneta 0:e9a7a38d9ad3 637 }
ohneta 0:e9a7a38d9ad3 638
ohneta 0:e9a7a38d9ad3 639 LIST *install(char *name, int nameConstKind = 0)
ohneta 0:e9a7a38d9ad3 640 {
ohneta 0:e9a7a38d9ad3 641 LIST *p;
ohneta 0:e9a7a38d9ad3 642
ohneta 0:e9a7a38d9ad3 643 p = cons(NULL, NULL);
ohneta 0:e9a7a38d9ad3 644 #if 0
ohneta 0:e9a7a38d9ad3 645 strcpy(p->u.pname = (char *)emalloc(strlen(name) + 1), name);
ohneta 0:e9a7a38d9ad3 646 #else
ohneta 0:e9a7a38d9ad3 647 if (nameConstKind == 0) {
ohneta 0:e9a7a38d9ad3 648 p->u.pname = (char *)emalloc(strlen(name) + 1);
ohneta 0:e9a7a38d9ad3 649 strcpy(p->u.pname, name);
ohneta 0:e9a7a38d9ad3 650 } else {
ohneta 0:e9a7a38d9ad3 651 p->u.pname = name;
ohneta 0:e9a7a38d9ad3 652 }
ohneta 0:e9a7a38d9ad3 653 #endif
ohneta 0:e9a7a38d9ad3 654 rplact(p, VARI);
ohneta 0:e9a7a38d9ad3 655 g_alist = cons(p, g_alist);
ohneta 0:e9a7a38d9ad3 656
ohneta 0:e9a7a38d9ad3 657 return p;
ohneta 0:e9a7a38d9ad3 658 }
ohneta 0:e9a7a38d9ad3 659
ohneta 0:e9a7a38d9ad3 660 LIST *getnum()
ohneta 0:e9a7a38d9ad3 661 {
ohneta 0:e9a7a38d9ad3 662 LIST *p;
ohneta 0:e9a7a38d9ad3 663 float sum, n;
ohneta 0:e9a7a38d9ad3 664 int c;
ohneta 0:e9a7a38d9ad3 665
ohneta 0:e9a7a38d9ad3 666 sum = 0.0;
ohneta 0:e9a7a38d9ad3 667 p = cons(NULL, NULL);
ohneta 0:e9a7a38d9ad3 668 rplact(p, IATOM);
ohneta 0:e9a7a38d9ad3 669
ohneta 0:e9a7a38d9ad3 670 while (isdigit(c = getc_mine(fd))) {
ohneta 0:e9a7a38d9ad3 671 sum = sum * 10 + c - '0';
ohneta 0:e9a7a38d9ad3 672 }
ohneta 0:e9a7a38d9ad3 673
ohneta 0:e9a7a38d9ad3 674 if (c == '.') { /* the number is real */
ohneta 0:e9a7a38d9ad3 675 n = 10;
ohneta 0:e9a7a38d9ad3 676 rplact(p, RATOM);
ohneta 0:e9a7a38d9ad3 677 //while (isdigit(c = getc(fd))) {
ohneta 0:e9a7a38d9ad3 678 while (isdigit(c = getc_mine(fd))) {
ohneta 0:e9a7a38d9ad3 679 sum += (c - '0')/n;
ohneta 0:e9a7a38d9ad3 680 n *= 10;
ohneta 0:e9a7a38d9ad3 681 }
ohneta 0:e9a7a38d9ad3 682 }
ohneta 0:e9a7a38d9ad3 683
ohneta 0:e9a7a38d9ad3 684 ungetc_mine(c, fd);
ohneta 0:e9a7a38d9ad3 685 p->u.num = sum;
ohneta 0:e9a7a38d9ad3 686
ohneta 0:e9a7a38d9ad3 687 return p;
ohneta 0:e9a7a38d9ad3 688 }
ohneta 0:e9a7a38d9ad3 689
ohneta 0:e9a7a38d9ad3 690 LIST *getid()
ohneta 0:e9a7a38d9ad3 691 {
ohneta 0:e9a7a38d9ad3 692 LIST *p;
ohneta 0:e9a7a38d9ad3 693
ohneta 0:e9a7a38d9ad3 694 char inbuf[120];
ohneta 0:e9a7a38d9ad3 695 char *s = inbuf;
ohneta 0:e9a7a38d9ad3 696 LIST *idptr;
ohneta 0:e9a7a38d9ad3 697
ohneta 0:e9a7a38d9ad3 698 int c = getc_mine(fd);
ohneta 0:e9a7a38d9ad3 699 *s = c;
ohneta 0:e9a7a38d9ad3 700 s++;
ohneta 0:e9a7a38d9ad3 701 if (c != '\'') {
ohneta 0:e9a7a38d9ad3 702 while(1) {
ohneta 0:e9a7a38d9ad3 703 c = getc_mine(fd);
ohneta 0:e9a7a38d9ad3 704 if (!isalnum(c)) {
ohneta 0:e9a7a38d9ad3 705 ungetc_mine(c, fd);
ohneta 0:e9a7a38d9ad3 706 break;
ohneta 0:e9a7a38d9ad3 707 }
ohneta 0:e9a7a38d9ad3 708 *s = c;
ohneta 0:e9a7a38d9ad3 709 s++;
ohneta 0:e9a7a38d9ad3 710 }
ohneta 0:e9a7a38d9ad3 711 }
ohneta 0:e9a7a38d9ad3 712 *s = '\0';
ohneta 0:e9a7a38d9ad3 713
ohneta 0:e9a7a38d9ad3 714 if ((idptr = lookup(g_oblist, inbuf)) == NULL) { // not a LISP function
ohneta 0:e9a7a38d9ad3 715 if ((idptr = lookup(g_alist, inbuf)) == NULL) { // id not declared yet
ohneta 0:e9a7a38d9ad3 716 idptr = install(inbuf, 0); // install it in g_alist (alist)
ohneta 0:e9a7a38d9ad3 717 }
ohneta 0:e9a7a38d9ad3 718 }
ohneta 0:e9a7a38d9ad3 719 p = cons(idptr, NULL);
ohneta 0:e9a7a38d9ad3 720 rplact(p, type(idptr));
ohneta 0:e9a7a38d9ad3 721
ohneta 0:e9a7a38d9ad3 722 return p;
ohneta 0:e9a7a38d9ad3 723 }
ohneta 0:e9a7a38d9ad3 724
ohneta 0:e9a7a38d9ad3 725 int gettok()
ohneta 0:e9a7a38d9ad3 726 {
ohneta 0:e9a7a38d9ad3 727 int c;
ohneta 0:e9a7a38d9ad3 728
ohneta 0:e9a7a38d9ad3 729 while ((c = advance()) == ';') { // saw a comment
ohneta 0:e9a7a38d9ad3 730 while (1) {
ohneta 0:e9a7a38d9ad3 731 c = getc_mine(fd);
ohneta 0:e9a7a38d9ad3 732 if ((c == EOF) || (c == '\n')) { // EOF or CR
ohneta 0:e9a7a38d9ad3 733 break;
ohneta 0:e9a7a38d9ad3 734 }
ohneta 0:e9a7a38d9ad3 735 }
ohneta 0:e9a7a38d9ad3 736 }
ohneta 0:e9a7a38d9ad3 737
ohneta 0:e9a7a38d9ad3 738 if (isalpha(c)) {
ohneta 0:e9a7a38d9ad3 739 return LETTER;
ohneta 0:e9a7a38d9ad3 740 }
ohneta 0:e9a7a38d9ad3 741 if (isdigit(c)) {
ohneta 0:e9a7a38d9ad3 742 return DIGIT;
ohneta 0:e9a7a38d9ad3 743 }
ohneta 0:e9a7a38d9ad3 744 switch (c) {
ohneta 0:e9a7a38d9ad3 745 case '(':
ohneta 0:e9a7a38d9ad3 746 return LPAREN;
ohneta 0:e9a7a38d9ad3 747 case ')':
ohneta 0:e9a7a38d9ad3 748 return RPAREN;
ohneta 0:e9a7a38d9ad3 749 case '\'':
ohneta 0:e9a7a38d9ad3 750 return INQUOTE;
ohneta 0:e9a7a38d9ad3 751 case EOF:
ohneta 0:e9a7a38d9ad3 752 return EOF;
ohneta 0:e9a7a38d9ad3 753 }
ohneta 0:e9a7a38d9ad3 754
ohneta 0:e9a7a38d9ad3 755 return ERR;
ohneta 0:e9a7a38d9ad3 756 }
ohneta 0:e9a7a38d9ad3 757
ohneta 0:e9a7a38d9ad3 758 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 759 // LISP primitive functions
ohneta 0:e9a7a38d9ad3 760 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 761
ohneta 0:e9a7a38d9ad3 762 // new - gets a new node from the free storage
ohneta 0:e9a7a38d9ad3 763 LIST *new_malisp()
ohneta 0:e9a7a38d9ad3 764 {
ohneta 0:e9a7a38d9ad3 765 LIST *p = (struct LIST *)emalloc(sizeof(LIST));
ohneta 0:e9a7a38d9ad3 766 p->gcbit = RUNNING;
ohneta 0:e9a7a38d9ad3 767
ohneta 0:e9a7a38d9ad3 768 return p;
ohneta 0:e9a7a38d9ad3 769 }
ohneta 0:e9a7a38d9ad3 770
ohneta 0:e9a7a38d9ad3 771 int type(LIST *p)
ohneta 0:e9a7a38d9ad3 772 {
ohneta 0:e9a7a38d9ad3 773 return p->htype;
ohneta 0:e9a7a38d9ad3 774 }
ohneta 0:e9a7a38d9ad3 775
ohneta 0:e9a7a38d9ad3 776 char* getname(LIST *p)
ohneta 0:e9a7a38d9ad3 777 {
ohneta 0:e9a7a38d9ad3 778 return (p == NULL) ? NULL : p->u.pname;
ohneta 0:e9a7a38d9ad3 779 }
ohneta 0:e9a7a38d9ad3 780
ohneta 0:e9a7a38d9ad3 781 // pのcar部をqに置き換える
ohneta 0:e9a7a38d9ad3 782 void rplaca(LIST *p, LIST *q)
ohneta 0:e9a7a38d9ad3 783 {
ohneta 0:e9a7a38d9ad3 784 p->left = q;
ohneta 0:e9a7a38d9ad3 785 }
ohneta 0:e9a7a38d9ad3 786
ohneta 0:e9a7a38d9ad3 787 // pのcdr部をqに置き換える
ohneta 0:e9a7a38d9ad3 788 void rplacd(LIST *p, LIST *q)
ohneta 0:e9a7a38d9ad3 789 {
ohneta 0:e9a7a38d9ad3 790 p->right = q;
ohneta 0:e9a7a38d9ad3 791 }
ohneta 0:e9a7a38d9ad3 792
ohneta 0:e9a7a38d9ad3 793 // pのタイプ(htype)をtに置き換える
ohneta 0:e9a7a38d9ad3 794 void rplact(LIST *p, int t)
ohneta 0:e9a7a38d9ad3 795 {
ohneta 0:e9a7a38d9ad3 796 p->htype = t;
ohneta 0:e9a7a38d9ad3 797 }
ohneta 0:e9a7a38d9ad3 798
ohneta 0:e9a7a38d9ad3 799 LIST *car(LIST *p)
ohneta 0:e9a7a38d9ad3 800 {
ohneta 0:e9a7a38d9ad3 801 return (p == NULL) ? NULL : p->left;
ohneta 0:e9a7a38d9ad3 802 }
ohneta 0:e9a7a38d9ad3 803
ohneta 0:e9a7a38d9ad3 804 LIST *cdr(LIST *p)
ohneta 0:e9a7a38d9ad3 805 {
ohneta 0:e9a7a38d9ad3 806 return (p == NULL) ? NULL : p->right;
ohneta 0:e9a7a38d9ad3 807 }
ohneta 0:e9a7a38d9ad3 808
ohneta 0:e9a7a38d9ad3 809 LIST *cons(LIST *p, LIST *q)
ohneta 0:e9a7a38d9ad3 810 {
ohneta 0:e9a7a38d9ad3 811 LIST *x = new_malisp();
ohneta 0:e9a7a38d9ad3 812
ohneta 0:e9a7a38d9ad3 813 /*
ohneta 0:e9a7a38d9ad3 814 // for debug
ohneta 0:e9a7a38d9ad3 815 {
ohneta 0:e9a7a38d9ad3 816 static int num = 0;
ohneta 0:e9a7a38d9ad3 817 x->gcbit = (num << 16) | x->gcbit;
ohneta 0:e9a7a38d9ad3 818 pc.printf("cons-num(%08x): %d\n", x->gcbit, num);
ohneta 0:e9a7a38d9ad3 819
ohneta 0:e9a7a38d9ad3 820 num++;
ohneta 0:e9a7a38d9ad3 821 }
ohneta 0:e9a7a38d9ad3 822 */
ohneta 0:e9a7a38d9ad3 823 rplaca(x, p);
ohneta 0:e9a7a38d9ad3 824 rplacd(x, q);
ohneta 0:e9a7a38d9ad3 825 rplact(x, LST);
ohneta 0:e9a7a38d9ad3 826
ohneta 0:e9a7a38d9ad3 827 return x;
ohneta 0:e9a7a38d9ad3 828 }
ohneta 0:e9a7a38d9ad3 829
ohneta 0:e9a7a38d9ad3 830 LIST *eq(LIST *x, LIST *y)
ohneta 0:e9a7a38d9ad3 831 {
ohneta 0:e9a7a38d9ad3 832 if (x == NULL || y == NULL) {
ohneta 0:e9a7a38d9ad3 833 if (x == y) {
ohneta 0:e9a7a38d9ad3 834 return TRU;
ohneta 0:e9a7a38d9ad3 835 }
ohneta 0:e9a7a38d9ad3 836 } else if (type(x) == SATOM && type(y) == SATOM && car(x) == car(y)) {
ohneta 0:e9a7a38d9ad3 837 return TRU;
ohneta 0:e9a7a38d9ad3 838 }
ohneta 0:e9a7a38d9ad3 839
ohneta 0:e9a7a38d9ad3 840 return NULL;
ohneta 0:e9a7a38d9ad3 841 }
ohneta 0:e9a7a38d9ad3 842
ohneta 0:e9a7a38d9ad3 843 LIST *atom(LIST *x)
ohneta 0:e9a7a38d9ad3 844 {
ohneta 0:e9a7a38d9ad3 845 int typ;
ohneta 0:e9a7a38d9ad3 846
ohneta 0:e9a7a38d9ad3 847 if (x == NULL || (typ = type(x)) == IATOM || typ == RATOM || typ == SATOM) {
ohneta 0:e9a7a38d9ad3 848 return TRU;
ohneta 0:e9a7a38d9ad3 849 }
ohneta 0:e9a7a38d9ad3 850
ohneta 0:e9a7a38d9ad3 851 return NULL;
ohneta 0:e9a7a38d9ad3 852 }
ohneta 0:e9a7a38d9ad3 853
ohneta 0:e9a7a38d9ad3 854 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 855 // logical connectives - and, or, not
ohneta 0:e9a7a38d9ad3 856
ohneta 0:e9a7a38d9ad3 857 LIST *_and(LIST *x)
ohneta 0:e9a7a38d9ad3 858 {
ohneta 0:e9a7a38d9ad3 859 LIST *p;
ohneta 0:e9a7a38d9ad3 860 for (p = cdr(x); p != NULL; p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 861 if (eval(car(p), NULL) == NULL) {
ohneta 0:e9a7a38d9ad3 862 return NULL;
ohneta 0:e9a7a38d9ad3 863 }
ohneta 0:e9a7a38d9ad3 864 }
ohneta 0:e9a7a38d9ad3 865
ohneta 0:e9a7a38d9ad3 866 return TRU;
ohneta 0:e9a7a38d9ad3 867 }
ohneta 0:e9a7a38d9ad3 868
ohneta 0:e9a7a38d9ad3 869 LIST *_or(LIST *x)
ohneta 0:e9a7a38d9ad3 870 {
ohneta 0:e9a7a38d9ad3 871 LIST *p;
ohneta 0:e9a7a38d9ad3 872 for (p = cdr(x); p != NULL; p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 873 if (eval(car(p), NULL) != NULL) {
ohneta 0:e9a7a38d9ad3 874 return TRU;
ohneta 0:e9a7a38d9ad3 875 }
ohneta 0:e9a7a38d9ad3 876 }
ohneta 0:e9a7a38d9ad3 877
ohneta 0:e9a7a38d9ad3 878 return NULL;
ohneta 0:e9a7a38d9ad3 879 }
ohneta 0:e9a7a38d9ad3 880
ohneta 0:e9a7a38d9ad3 881 LIST *_not(LIST *x)
ohneta 0:e9a7a38d9ad3 882 {
ohneta 0:e9a7a38d9ad3 883 return (eval(cdr(x), NULL) == NULL) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 884 }
ohneta 0:e9a7a38d9ad3 885
ohneta 0:e9a7a38d9ad3 886 // other primitives
ohneta 0:e9a7a38d9ad3 887
ohneta 0:e9a7a38d9ad3 888 LIST *_list(LIST *x)
ohneta 0:e9a7a38d9ad3 889 {
ohneta 0:e9a7a38d9ad3 890 LIST *res, *p;
ohneta 0:e9a7a38d9ad3 891
ohneta 0:e9a7a38d9ad3 892 for (res = NULL, p = cdr(x); p != NULL; p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 893 res = cons(res, car(p));
ohneta 0:e9a7a38d9ad3 894 }
ohneta 0:e9a7a38d9ad3 895
ohneta 0:e9a7a38d9ad3 896 return res;
ohneta 0:e9a7a38d9ad3 897 }
ohneta 0:e9a7a38d9ad3 898
ohneta 0:e9a7a38d9ad3 899
ohneta 0:e9a7a38d9ad3 900 void var_to_user(LIST *p)
ohneta 0:e9a7a38d9ad3 901 {
ohneta 0:e9a7a38d9ad3 902 if (p == NULL) {
ohneta 0:e9a7a38d9ad3 903 return;
ohneta 0:e9a7a38d9ad3 904 }
ohneta 0:e9a7a38d9ad3 905
ohneta 0:e9a7a38d9ad3 906 if (type(p) == VARI) {
ohneta 0:e9a7a38d9ad3 907 if (type(car(p)) == FUSER) {
ohneta 0:e9a7a38d9ad3 908 rplact(p, FUSER);
ohneta 0:e9a7a38d9ad3 909 }
ohneta 0:e9a7a38d9ad3 910 } else if (type(p) == LST) {
ohneta 0:e9a7a38d9ad3 911 var_to_user(car(p));
ohneta 0:e9a7a38d9ad3 912 var_to_user(cdr(p));
ohneta 0:e9a7a38d9ad3 913 }
ohneta 0:e9a7a38d9ad3 914 }
ohneta 0:e9a7a38d9ad3 915
ohneta 0:e9a7a38d9ad3 916 void var_to_atom(LIST *p)
ohneta 0:e9a7a38d9ad3 917 {
ohneta 0:e9a7a38d9ad3 918 int t;
ohneta 0:e9a7a38d9ad3 919
ohneta 0:e9a7a38d9ad3 920 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 921 if (((t = type(p)) != LST && !isfunc(t)) || t == FUSER) {
ohneta 0:e9a7a38d9ad3 922 rplact(p, SATOM);
ohneta 0:e9a7a38d9ad3 923 } else {
ohneta 0:e9a7a38d9ad3 924 var_to_atom(car(p)); var_to_atom(cdr(p));
ohneta 0:e9a7a38d9ad3 925 }
ohneta 0:e9a7a38d9ad3 926 }
ohneta 0:e9a7a38d9ad3 927 }
ohneta 0:e9a7a38d9ad3 928
ohneta 0:e9a7a38d9ad3 929 // find_labels - change the type of all labels in a PROG to LABL
ohneta 0:e9a7a38d9ad3 930 void find_labels(LIST *p)
ohneta 0:e9a7a38d9ad3 931 {
ohneta 0:e9a7a38d9ad3 932 for ( ; p != NULL; p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 933 if (type(car(p)) == VARI) {
ohneta 0:e9a7a38d9ad3 934 rplact(car(p), LABL); // change the type to LABL
ohneta 0:e9a7a38d9ad3 935 rplacd(car(car(p)), cdr(p)); // label points to next statement
ohneta 0:e9a7a38d9ad3 936 }
ohneta 0:e9a7a38d9ad3 937 }
ohneta 0:e9a7a38d9ad3 938 }
ohneta 0:e9a7a38d9ad3 939
ohneta 0:e9a7a38d9ad3 940 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 941 // garbage collection
ohneta 0:e9a7a38d9ad3 942 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 943
ohneta 0:e9a7a38d9ad3 944 void work_garbageCollect(LIST *p)
ohneta 0:e9a7a38d9ad3 945 {
ohneta 0:e9a7a38d9ad3 946 int cnt = 0;
ohneta 0:e9a7a38d9ad3 947 while (p != NULL) {
ohneta 0:e9a7a38d9ad3 948
ohneta 0:e9a7a38d9ad3 949 int t = type(p);
ohneta 0:e9a7a38d9ad3 950
ohneta 0:e9a7a38d9ad3 951 pc.printf("[%d] ", cnt);
ohneta 0:e9a7a38d9ad3 952 pc.printf("(%d) ", t);
ohneta 0:e9a7a38d9ad3 953 if ((t == IATOM) || (t == RATOM)) {
ohneta 0:e9a7a38d9ad3 954 pc.printf("[%f ] : ", p->u.num);
ohneta 0:e9a7a38d9ad3 955 } else if (t == SATOM) {
ohneta 0:e9a7a38d9ad3 956 pc.printf("[%s ] : ", p->u.pname);
ohneta 0:e9a7a38d9ad3 957 } else {
ohneta 0:e9a7a38d9ad3 958 pc.printf(" : ");
ohneta 0:e9a7a38d9ad3 959 }
ohneta 0:e9a7a38d9ad3 960
ohneta 0:e9a7a38d9ad3 961 pc.printf("%d : ", (p->gcbit >> 16) & 0xff); // num
ohneta 0:e9a7a38d9ad3 962 pc.printf("%d \n", (p->gcbit & 0xff)); // bit (USED/RUNNING)
ohneta 0:e9a7a38d9ad3 963
ohneta 0:e9a7a38d9ad3 964 p = cdr(p);
ohneta 0:e9a7a38d9ad3 965 cnt++;
ohneta 0:e9a7a38d9ad3 966 }
ohneta 0:e9a7a38d9ad3 967 }
ohneta 0:e9a7a38d9ad3 968
ohneta 0:e9a7a38d9ad3 969 // marktree - recursively marks all used items in a list
ohneta 0:e9a7a38d9ad3 970 void marktree(LIST *p)
ohneta 0:e9a7a38d9ad3 971 {
ohneta 0:e9a7a38d9ad3 972 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 973 if (type(p) == LST) {
ohneta 0:e9a7a38d9ad3 974 marktree(car(p));
ohneta 0:e9a7a38d9ad3 975 marktree(cdr(p));
ohneta 0:e9a7a38d9ad3 976 }
ohneta 0:e9a7a38d9ad3 977 p->gcbit = USED;
ohneta 0:e9a7a38d9ad3 978 }
ohneta 0:e9a7a38d9ad3 979 }
ohneta 0:e9a7a38d9ad3 980
ohneta 0:e9a7a38d9ad3 981 /*********************** storage allocator *****************/
ohneta 0:e9a7a38d9ad3 982
ohneta 0:e9a7a38d9ad3 983 void *emalloc(size_t size)
ohneta 0:e9a7a38d9ad3 984 {
ohneta 0:e9a7a38d9ad3 985 void *s;
ohneta 0:e9a7a38d9ad3 986
ohneta 0:e9a7a38d9ad3 987 if ((s = malloc(size)) == NULL) {
ohneta 0:e9a7a38d9ad3 988 pc.printf("OUT OF MEMORY !! : crashed !! \n");
ohneta 0:e9a7a38d9ad3 989 exit(0);
ohneta 0:e9a7a38d9ad3 990 }
ohneta 0:e9a7a38d9ad3 991
ohneta 0:e9a7a38d9ad3 992 return s;
ohneta 0:e9a7a38d9ad3 993 }
ohneta 0:e9a7a38d9ad3 994
ohneta 0:e9a7a38d9ad3 995 // routine to load the library of lisp functions in
ohneta 0:e9a7a38d9ad3 996 void load_library(void)
ohneta 0:e9a7a38d9ad3 997 {
ohneta 0:e9a7a38d9ad3 998 #if 0
ohneta 0:e9a7a38d9ad3 999 char libpath[1024];
ohneta 0:e9a7a38d9ad3 1000 strcpy(libpath, getenv("HOME"));
ohneta 0:e9a7a38d9ad3 1001 strcat(libpath, "/lisplib");
ohneta 0:e9a7a38d9ad3 1002
ohneta 0:e9a7a38d9ad3 1003 if ((fd = fopen(libpath, "r")) != NULL) {
ohneta 0:e9a7a38d9ad3 1004 interpret_malisp();
ohneta 0:e9a7a38d9ad3 1005 fclose(fd);
ohneta 0:e9a7a38d9ad3 1006
ohneta 0:e9a7a38d9ad3 1007 pc.printf("loaded lisplib from %s\n", libpath);
ohneta 0:e9a7a38d9ad3 1008 }
ohneta 0:e9a7a38d9ad3 1009 interpret_malisp();
ohneta 0:e9a7a38d9ad3 1010
ohneta 0:e9a7a38d9ad3 1011 fd = stdin;
ohneta 0:e9a7a38d9ad3 1012 #else
ohneta 0:e9a7a38d9ad3 1013
ohneta 0:e9a7a38d9ad3 1014 fd = FILE_STRING;
ohneta 0:e9a7a38d9ad3 1015 interpret_malisp();
ohneta 0:e9a7a38d9ad3 1016 pc.printf("loaded lisplib from flash\n");
ohneta 0:e9a7a38d9ad3 1017
ohneta 0:e9a7a38d9ad3 1018 fd = FILE_SERIAL;
ohneta 0:e9a7a38d9ad3 1019
ohneta 0:e9a7a38d9ad3 1020 #endif
ohneta 0:e9a7a38d9ad3 1021 }
ohneta 0:e9a7a38d9ad3 1022
ohneta 0:e9a7a38d9ad3 1023 // isfunc - returns YES if type t is a user-function or a lisp primitive
ohneta 0:e9a7a38d9ad3 1024 int isfunc(int t)
ohneta 0:e9a7a38d9ad3 1025 {
ohneta 0:e9a7a38d9ad3 1026 return
ohneta 0:e9a7a38d9ad3 1027 ( t==FUSER || t==ADD1 || t==SUB1 || t==PLUS || t==DIFF || t==TIMES ||
ohneta 0:e9a7a38d9ad3 1028 t==QUOTIENT || t==LESSP || t==GREATERP || t==ZEROP || t==NUMBERP ||
ohneta 0:e9a7a38d9ad3 1029 t==FCAR || t==FCDR || t==FCONS || t==FREAD || t==PRINT || t==FNOT||
ohneta 0:e9a7a38d9ad3 1030 t==FAND || t==FOR || t==FEVAL || t==FEQ || t==FATOM ||
ohneta 0:e9a7a38d9ad3 1031
ohneta 0:e9a7a38d9ad3 1032 // mbed extends
ohneta 0:e9a7a38d9ad3 1033 t == FFREEMEM || t == FWAIT || t == FDOUT || t == FDIN ||
ohneta 0:e9a7a38d9ad3 1034 t == FAOUT || t == FAIN || t == PWMOUT
ohneta 0:e9a7a38d9ad3 1035 );
ohneta 0:e9a7a38d9ad3 1036 }
ohneta 0:e9a7a38d9ad3 1037
ohneta 0:e9a7a38d9ad3 1038 void debug(LIST *p)
ohneta 0:e9a7a38d9ad3 1039 {
ohneta 0:e9a7a38d9ad3 1040 pc.printf("DEBUG ---\n");
ohneta 0:e9a7a38d9ad3 1041 debug2(p);
ohneta 0:e9a7a38d9ad3 1042 pc.printf("\n");
ohneta 0:e9a7a38d9ad3 1043 }
ohneta 0:e9a7a38d9ad3 1044
ohneta 0:e9a7a38d9ad3 1045 void debug2(LIST *p)
ohneta 0:e9a7a38d9ad3 1046 {
ohneta 0:e9a7a38d9ad3 1047 int t;
ohneta 0:e9a7a38d9ad3 1048
ohneta 0:e9a7a38d9ad3 1049 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 1050 if ((t = type(p)) == LST) {
ohneta 0:e9a7a38d9ad3 1051 pc.printf("(");
ohneta 0:e9a7a38d9ad3 1052 debug2(car(p));
ohneta 0:e9a7a38d9ad3 1053 debug2(cdr(p));
ohneta 0:e9a7a38d9ad3 1054 pc.printf(")");
ohneta 0:e9a7a38d9ad3 1055 } else if (t == RATOM) {
ohneta 0:e9a7a38d9ad3 1056 pc.printf("RATOM %f ", p->u.num);
ohneta 0:e9a7a38d9ad3 1057 } else if (t == IATOM) {
ohneta 0:e9a7a38d9ad3 1058 pc.printf("IATOM %d ", (int) p->u.num);
ohneta 0:e9a7a38d9ad3 1059 } else if (t == SATOM) {
ohneta 0:e9a7a38d9ad3 1060 pc.printf("SATOM %s ", getname(car(p)));
ohneta 0:e9a7a38d9ad3 1061 } else {
ohneta 0:e9a7a38d9ad3 1062 pc.printf("FUNC %d ", type(p));
ohneta 0:e9a7a38d9ad3 1063 }
ohneta 0:e9a7a38d9ad3 1064 }
ohneta 0:e9a7a38d9ad3 1065 }