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@1:a2955606adef, 2016-05-21 (annotated)

Committer:
ohneta
Date:
Sat May 21 22:26:40 2016 +0000
Revision:
1:a2955606adef
Parent:
0:e9a7a38d9ad3 
??commit

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 1:a2955606adef 165 TRU = cons(init("t", T), NULL);
ohneta 1:a2955606adef 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 1:a2955606adef 174
ohneta 0:e9a7a38d9ad3 175 init("wait", FWAIT);
ohneta 0:e9a7a38d9ad3 176 init("dout", FDOUT);
ohneta 0:e9a7a38d9ad3 177 init("din", FDIN);
ohneta 0:e9a7a38d9ad3 178 init("aout", FAOUT);
ohneta 0:e9a7a38d9ad3 179 init("ain", FAIN);
ohneta 0:e9a7a38d9ad3 180 init("pwmout", PWMOUT);
ohneta 0:e9a7a38d9ad3 181
ohneta 0:e9a7a38d9ad3 182 g_oblist = g_alist;
ohneta 0:e9a7a38d9ad3 183 }
ohneta 0:e9a7a38d9ad3 184
ohneta 0:e9a7a38d9ad3 185 LIST *init(char *name, int t)
ohneta 0:e9a7a38d9ad3 186 {
ohneta 1:a2955606adef 187 LIST *p = install(name, false);
ohneta 1:a2955606adef 188 rplact(p, t);
ohneta 0:e9a7a38d9ad3 189
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 1:a2955606adef 236 if (p == NULL) {
ohneta 1:a2955606adef 237 return;
ohneta 1:a2955606adef 238 }
ohneta 1:a2955606adef 239
ohneta 1:a2955606adef 240 if (type(p) == RATOM) {
ohneta 1:a2955606adef 241 pc.printf("%f ", p->u.num);
ohneta 1:a2955606adef 242 } else if (type(p) == IATOM) {
ohneta 1:a2955606adef 243 pc.printf("%d ", (int) p->u.num);
ohneta 1:a2955606adef 244 } else if (type(p) == SATOM) {
ohneta 1:a2955606adef 245 pc.printf("%s ", getname(car(p)));
ohneta 1:a2955606adef 246 } else if (type(car(p)) == LST) {
ohneta 1:a2955606adef 247 pc.printf("%c", '(');
ohneta 1:a2955606adef 248 lisp_print(car(p));
ohneta 1:a2955606adef 249 pc.printf("%c", ')');
ohneta 1:a2955606adef 250 lisp_print(cdr(p));
ohneta 1:a2955606adef 251 } else if (type(p) == LST) {
ohneta 1:a2955606adef 252 lisp_print(car(p));
ohneta 1:a2955606adef 253 lisp_print(cdr(p));
ohneta 1:a2955606adef 254 } else {
ohneta 1:a2955606adef 255 pc.printf("******** can't print it out *******\n");
ohneta 0:e9a7a38d9ad3 256 }
ohneta 0:e9a7a38d9ad3 257 }
ohneta 0:e9a7a38d9ad3 258
ohneta 0:e9a7a38d9ad3 259 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 260 // evaluate a LISP function
ohneta 0:e9a7a38d9ad3 261 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 262
ohneta 0:e9a7a38d9ad3 263 LIST *eval(LIST *x, LIST *alist)
ohneta 0:e9a7a38d9ad3 264 {
ohneta 0:e9a7a38d9ad3 265 LIST *p, *q;
ohneta 0:e9a7a38d9ad3 266 int savt, t;
ohneta 0:e9a7a38d9ad3 267
ohneta 0:e9a7a38d9ad3 268 if (x == NULL) {
ohneta 0:e9a7a38d9ad3 269 return NULL;
ohneta 0:e9a7a38d9ad3 270 }
ohneta 0:e9a7a38d9ad3 271 t = type(x);
ohneta 0:e9a7a38d9ad3 272 if (t == VARI) {
ohneta 0:e9a7a38d9ad3 273 return assoc(alist, getname(car(x)));
ohneta 0:e9a7a38d9ad3 274 }
ohneta 0:e9a7a38d9ad3 275 if (t == IATOM || t == RATOM) {
ohneta 0:e9a7a38d9ad3 276 return x;
ohneta 0:e9a7a38d9ad3 277 }
ohneta 0:e9a7a38d9ad3 278 if (t == LABL) {
ohneta 0:e9a7a38d9ad3 279 return NULL;
ohneta 0:e9a7a38d9ad3 280 }
ohneta 0:e9a7a38d9ad3 281
ohneta 0:e9a7a38d9ad3 282 switch (type(car(x))) {
ohneta 0:e9a7a38d9ad3 283 case T:
ohneta 0:e9a7a38d9ad3 284 return TRU;
ohneta 0:e9a7a38d9ad3 285
ohneta 0:e9a7a38d9ad3 286 case NILL:
ohneta 0:e9a7a38d9ad3 287 return NULL;
ohneta 0:e9a7a38d9ad3 288
ohneta 0:e9a7a38d9ad3 289 case QUOTE:
ohneta 0:e9a7a38d9ad3 290 var_to_atom(car(cdr(x)));
ohneta 0:e9a7a38d9ad3 291 return car(cdr(x));
ohneta 0:e9a7a38d9ad3 292
ohneta 0:e9a7a38d9ad3 293 case FCAR:
ohneta 0:e9a7a38d9ad3 294 return car(eval(cdr(x), alist));
ohneta 0:e9a7a38d9ad3 295
ohneta 0:e9a7a38d9ad3 296 case FCDR:
ohneta 0:e9a7a38d9ad3 297 return cdr(eval(cdr(x), alist));
ohneta 0:e9a7a38d9ad3 298
ohneta 0:e9a7a38d9ad3 299 case FATOM:
ohneta 0:e9a7a38d9ad3 300 return atom(eval(cdr(x), alist));
ohneta 0:e9a7a38d9ad3 301
ohneta 0:e9a7a38d9ad3 302 case FEQ:
ohneta 0:e9a7a38d9ad3 303 return eq(eval(car(cdr(x)),alist), eval(cdr(cdr(x)),alist));
ohneta 0:e9a7a38d9ad3 304
ohneta 0:e9a7a38d9ad3 305 case NUL:
ohneta 0:e9a7a38d9ad3 306 return eq(eval(car(cdr(x)), alist), NULL);
ohneta 0:e9a7a38d9ad3 307
ohneta 0:e9a7a38d9ad3 308 case FCONS:
ohneta 0:e9a7a38d9ad3 309 return cons(eval(car(cdr(x)),alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 310
ohneta 0:e9a7a38d9ad3 311 case FLIST:
ohneta 0:e9a7a38d9ad3 312 return _list(x);
ohneta 0:e9a7a38d9ad3 313
ohneta 0:e9a7a38d9ad3 314 case COND:
ohneta 0:e9a7a38d9ad3 315 return evalcond(cdr(x), alist);
ohneta 0:e9a7a38d9ad3 316
ohneta 0:e9a7a38d9ad3 317 case FSETQ:
ohneta 0:e9a7a38d9ad3 318 p = eval(cdr(cdr(x)), alist);
ohneta 0:e9a7a38d9ad3 319 rplacd(getvar(alist, getname(car(car(cdr(x))))), p);
ohneta 0:e9a7a38d9ad3 320 return p;
ohneta 0:e9a7a38d9ad3 321
ohneta 0:e9a7a38d9ad3 322 case DEFUN:
ohneta 0:e9a7a38d9ad3 323 rplact(car(car(cdr(x))), FUSER);
ohneta 0:e9a7a38d9ad3 324 rplacd(car(car(cdr(x))), cdr(cdr(x)));
ohneta 0:e9a7a38d9ad3 325 var_to_user(cdr(cdr(cdr(x))));
ohneta 0:e9a7a38d9ad3 326 if (fd == FILE_SERIAL) {
ohneta 0:e9a7a38d9ad3 327 pc.printf("%s\n", getname(car(car(cdr(x)))));
ohneta 0:e9a7a38d9ad3 328 }
ohneta 0:e9a7a38d9ad3 329 return NULL;
ohneta 0:e9a7a38d9ad3 330
ohneta 0:e9a7a38d9ad3 331 case FUSER:
ohneta 0:e9a7a38d9ad3 332 p = cdr(car(car(x))); // p is statement list
ohneta 0:e9a7a38d9ad3 333 return eval(car(cdr(p)), pairargs(car(p), evalargs(cdr(x),alist), alist, FALSE));
ohneta 0:e9a7a38d9ad3 334
ohneta 0:e9a7a38d9ad3 335 case FAPPLY:
ohneta 0:e9a7a38d9ad3 336 case FUNCALL:
ohneta 0:e9a7a38d9ad3 337 p = eval(car(cdr(x)), alist); // func name
ohneta 0:e9a7a38d9ad3 338 if (isfunc(savt = type(car(p)))) {
ohneta 0:e9a7a38d9ad3 339 p = cons(p, cdr(cdr(x)));
ohneta 0:e9a7a38d9ad3 340 if (savt == FUSER) {
ohneta 0:e9a7a38d9ad3 341 rplact(car(p), FUSER);
ohneta 0:e9a7a38d9ad3 342 }
ohneta 0:e9a7a38d9ad3 343 q = eval(p, alist);
ohneta 0:e9a7a38d9ad3 344 rplact(car(p), savt);
ohneta 0:e9a7a38d9ad3 345 return q;
ohneta 0:e9a7a38d9ad3 346 } else
ohneta 0:e9a7a38d9ad3 347 return NULL;
ohneta 0:e9a7a38d9ad3 348
ohneta 0:e9a7a38d9ad3 349 case FEVAL:
ohneta 0:e9a7a38d9ad3 350 p = eval(cdr(x), alist);
ohneta 0:e9a7a38d9ad3 351 if (type(p) == SATOM) {
ohneta 0:e9a7a38d9ad3 352 return assoc(alist, getname(car(p)));
ohneta 0:e9a7a38d9ad3 353 }
ohneta 0:e9a7a38d9ad3 354 return eval(p, alist);
ohneta 0:e9a7a38d9ad3 355
ohneta 0:e9a7a38d9ad3 356 case PRINT:
ohneta 0:e9a7a38d9ad3 357 lisp_print(eval(car(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 358 pc.printf("\n");
ohneta 0:e9a7a38d9ad3 359 return NULL;
ohneta 0:e9a7a38d9ad3 360
ohneta 0:e9a7a38d9ad3 361 case FREAD:
ohneta 0:e9a7a38d9ad3 362 return makelist();
ohneta 0:e9a7a38d9ad3 363
ohneta 0:e9a7a38d9ad3 364 case FAND:
ohneta 0:e9a7a38d9ad3 365 return _and(x);
ohneta 0:e9a7a38d9ad3 366 case FOR:
ohneta 0:e9a7a38d9ad3 367 return _or(x);
ohneta 0:e9a7a38d9ad3 368 case FNOT:
ohneta 0:e9a7a38d9ad3 369 return _not(x);
ohneta 0:e9a7a38d9ad3 370
ohneta 0:e9a7a38d9ad3 371 case PLUS:
ohneta 0:e9a7a38d9ad3 372 case DIFF:
ohneta 0:e9a7a38d9ad3 373 case TIMES:
ohneta 0:e9a7a38d9ad3 374 case QUOTIENT:
ohneta 0:e9a7a38d9ad3 375 case GREATERP:
ohneta 0:e9a7a38d9ad3 376 case LESSP:
ohneta 0:e9a7a38d9ad3 377 return arith(car(x), eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 378
ohneta 0:e9a7a38d9ad3 379 case ADD1:
ohneta 0:e9a7a38d9ad3 380 case SUB1:
ohneta 0:e9a7a38d9ad3 381 return arith(car(x), eval(car(cdr(x)), alist), NULL);
ohneta 0:e9a7a38d9ad3 382
ohneta 0:e9a7a38d9ad3 383 case ZEROP:
ohneta 0:e9a7a38d9ad3 384 p = eval(car(cdr(x)), alist);
ohneta 0:e9a7a38d9ad3 385 return (p->u.num == 0) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 386
ohneta 0:e9a7a38d9ad3 387 case NUMBERP:
ohneta 0:e9a7a38d9ad3 388 savt = type(eval(car(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 389 return (savt==IATOM || savt==RATOM) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 390
ohneta 0:e9a7a38d9ad3 391 case PROG:
ohneta 0:e9a7a38d9ad3 392 return evalprog(x, alist);
ohneta 0:e9a7a38d9ad3 393
ohneta 0:e9a7a38d9ad3 394 case GO:
ohneta 0:e9a7a38d9ad3 395 return cdr(car(car(cdr(x))));
ohneta 0:e9a7a38d9ad3 396
ohneta 0:e9a7a38d9ad3 397 case RETRN:
ohneta 0:e9a7a38d9ad3 398 progon = FALSE;
ohneta 0:e9a7a38d9ad3 399 return eval(cdr(x), alist);
ohneta 0:e9a7a38d9ad3 400
ohneta 0:e9a7a38d9ad3 401 case LST:
ohneta 0:e9a7a38d9ad3 402 if (cdr(x) == NULL) {
ohneta 0:e9a7a38d9ad3 403 return eval(car(x), alist);
ohneta 0:e9a7a38d9ad3 404 }
ohneta 0:e9a7a38d9ad3 405 return cons(eval(car(x),alist),eval(cdr(x),alist));
ohneta 0:e9a7a38d9ad3 406
ohneta 0:e9a7a38d9ad3 407 case VARI:
ohneta 0:e9a7a38d9ad3 408 return assoc(alist, getname(car(car(x))));
ohneta 0:e9a7a38d9ad3 409
ohneta 0:e9a7a38d9ad3 410 case IATOM:
ohneta 0:e9a7a38d9ad3 411 case RATOM:
ohneta 0:e9a7a38d9ad3 412 return car(x);
ohneta 0:e9a7a38d9ad3 413
ohneta 0:e9a7a38d9ad3 414
ohneta 0:e9a7a38d9ad3 415
ohneta 0:e9a7a38d9ad3 416 // mbed expand
ohneta 0:e9a7a38d9ad3 417 case FINFO:
ohneta 0:e9a7a38d9ad3 418 {
ohneta 0:e9a7a38d9ad3 419 pc.printf("\noblist --\n");
ohneta 0:e9a7a38d9ad3 420 debug(g_oblist);
ohneta 0:e9a7a38d9ad3 421
ohneta 0:e9a7a38d9ad3 422 return NULL;
ohneta 0:e9a7a38d9ad3 423 }
ohneta 0:e9a7a38d9ad3 424 case FFREEMEM:
ohneta 0:e9a7a38d9ad3 425 {
ohneta 0:e9a7a38d9ad3 426 LIST * p = memfreesize();
ohneta 0:e9a7a38d9ad3 427 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 428 p->gcbit = GARBAGE;
ohneta 0:e9a7a38d9ad3 429 }
ohneta 0:e9a7a38d9ad3 430 return p;
ohneta 0:e9a7a38d9ad3 431 }
ohneta 0:e9a7a38d9ad3 432 case FWAIT:
ohneta 0:e9a7a38d9ad3 433 {
ohneta 0:e9a7a38d9ad3 434 LIST * p = mbed_wait(eval(car(cdr(x)), alist));
ohneta 1:a2955606adef 435 /*
ohneta 0:e9a7a38d9ad3 436 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 437 p->gcbit = GARBAGE;
ohneta 0:e9a7a38d9ad3 438 }
ohneta 1:a2955606adef 439 */
ohneta 0:e9a7a38d9ad3 440 return p;
ohneta 0:e9a7a38d9ad3 441 }
ohneta 0:e9a7a38d9ad3 442 case FDOUT:
ohneta 0:e9a7a38d9ad3 443 return mbed_digitalout(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 444 case FDIN:
ohneta 0:e9a7a38d9ad3 445 return mbed_digitalin(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 446 case FAOUT:
ohneta 0:e9a7a38d9ad3 447 return mbed_analogout(eval(car(cdr(x)), alist), eval(cdr(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 448 case FAIN:
ohneta 0:e9a7a38d9ad3 449 return mbed_analogin(eval(car(cdr(x)), alist));
ohneta 0:e9a7a38d9ad3 450 case PWMOUT:
ohneta 0:e9a7a38d9ad3 451 return mbed_pwmout(eval(car(cdr(x)), alist), eval(car(cdr(cdr(x))), alist), eval(cdr(cdr(cdr(x))), alist));
ohneta 0:e9a7a38d9ad3 452 }
ohneta 0:e9a7a38d9ad3 453
ohneta 0:e9a7a38d9ad3 454 return NULL;
ohneta 0:e9a7a38d9ad3 455 }
ohneta 0:e9a7a38d9ad3 456
ohneta 0:e9a7a38d9ad3 457
ohneta 0:e9a7a38d9ad3 458 LIST *evalcond(LIST *expr, LIST *alist)
ohneta 0:e9a7a38d9ad3 459 {
ohneta 0:e9a7a38d9ad3 460 if (expr == NULL) {
ohneta 0:e9a7a38d9ad3 461 return NULL;
ohneta 0:e9a7a38d9ad3 462 }
ohneta 0:e9a7a38d9ad3 463
ohneta 0:e9a7a38d9ad3 464 if (eval(car(car(expr)), alist) != NULL) { // expr was true
ohneta 0:e9a7a38d9ad3 465 return eval(car(cdr(car(expr))), alist); // return result
ohneta 0:e9a7a38d9ad3 466 }
ohneta 0:e9a7a38d9ad3 467
ohneta 0:e9a7a38d9ad3 468 return evalcond(cdr(expr), alist); // eval rest of args
ohneta 0:e9a7a38d9ad3 469 }
ohneta 0:e9a7a38d9ad3 470
ohneta 0:e9a7a38d9ad3 471
ohneta 0:e9a7a38d9ad3 472 LIST *evalprog(LIST *p, LIST *alist)
ohneta 0:e9a7a38d9ad3 473 {
ohneta 0:e9a7a38d9ad3 474 LIST *x = NULL;
ohneta 0:e9a7a38d9ad3 475
ohneta 0:e9a7a38d9ad3 476 // set up parameters as locals
ohneta 0:e9a7a38d9ad3 477 alist = pairargs(car(cdr(p)), cons(NULL, NULL), alist, TRUE);
ohneta 0:e9a7a38d9ad3 478 progon = TRUE;
ohneta 0:e9a7a38d9ad3 479 p = cdr(cdr(p)); /* p now points to the statement list */
ohneta 0:e9a7a38d9ad3 480 find_labels(p); /* set up all labels in the prog */
ohneta 0:e9a7a38d9ad3 481
ohneta 0:e9a7a38d9ad3 482 while (p != NULL && progon) {
ohneta 0:e9a7a38d9ad3 483 x = eval(car(p), alist);
ohneta 0:e9a7a38d9ad3 484 if (type(car(car(p))) == GO) {
ohneta 0:e9a7a38d9ad3 485 p = x; /* GO returned the next statement to go to */
ohneta 0:e9a7a38d9ad3 486 } else {
ohneta 0:e9a7a38d9ad3 487 p = cdr(p); /* just follow regular chain of statements */
ohneta 0:e9a7a38d9ad3 488
ohneta 0:e9a7a38d9ad3 489 }
ohneta 0:e9a7a38d9ad3 490 }
ohneta 0:e9a7a38d9ad3 491
ohneta 0:e9a7a38d9ad3 492 progon = TRUE; /* in case of nested progs */
ohneta 0:e9a7a38d9ad3 493 return x;
ohneta 0:e9a7a38d9ad3 494 }
ohneta 0:e9a7a38d9ad3 495
ohneta 0:e9a7a38d9ad3 496 // pairargs - installs parameters in the alist, and sets the value to be the value of the corresponding argument.
ohneta 0:e9a7a38d9ad3 497 LIST *pairargs(LIST *params, LIST *args, LIST *alist, int prog)
ohneta 0:e9a7a38d9ad3 498 {
ohneta 0:e9a7a38d9ad3 499 if (params == NULL) { // no more args to be evaluated
ohneta 0:e9a7a38d9ad3 500 return alist;
ohneta 0:e9a7a38d9ad3 501 }
ohneta 0:e9a7a38d9ad3 502
ohneta 0:e9a7a38d9ad3 503 LIST *p = cons(NULL, car(args)); // value of param is corresponding arg
ohneta 0:e9a7a38d9ad3 504 p->u.pname = getname(car(car(params)));
ohneta 0:e9a7a38d9ad3 505 rplact(p, VARI);
ohneta 0:e9a7a38d9ad3 506 if (prog) {
ohneta 0:e9a7a38d9ad3 507 return cons(p, pairargs(cdr(params), cons(NULL,NULL), alist, prog));
ohneta 0:e9a7a38d9ad3 508 }
ohneta 0:e9a7a38d9ad3 509
ohneta 0:e9a7a38d9ad3 510 return cons(p, pairargs(cdr(params), cdr(args), alist, prog));
ohneta 0:e9a7a38d9ad3 511 }
ohneta 0:e9a7a38d9ad3 512
ohneta 0:e9a7a38d9ad3 513 LIST *evalargs(LIST *arglist, LIST *alist)
ohneta 0:e9a7a38d9ad3 514 {
ohneta 0:e9a7a38d9ad3 515 if (arglist == NULL) {
ohneta 0:e9a7a38d9ad3 516 return NULL;
ohneta 0:e9a7a38d9ad3 517 }
ohneta 0:e9a7a38d9ad3 518
ohneta 0:e9a7a38d9ad3 519 return cons(eval(car(arglist),alist), evalargs(cdr(arglist), alist));
ohneta 0:e9a7a38d9ad3 520 }
ohneta 0:e9a7a38d9ad3 521
ohneta 0:e9a7a38d9ad3 522 LIST *assoc( LIST *alist, char *name)
ohneta 0:e9a7a38d9ad3 523 {
ohneta 0:e9a7a38d9ad3 524 return cdr(getvar(alist, name));
ohneta 0:e9a7a38d9ad3 525 }
ohneta 0:e9a7a38d9ad3 526
ohneta 0:e9a7a38d9ad3 527 LIST *getvar(LIST *alist, char *name)
ohneta 0:e9a7a38d9ad3 528 {
ohneta 0:e9a7a38d9ad3 529 return lookup(alist, name);
ohneta 0:e9a7a38d9ad3 530 }
ohneta 0:e9a7a38d9ad3 531
ohneta 0:e9a7a38d9ad3 532 // arith - performs arithmetic on numeric items
ohneta 0:e9a7a38d9ad3 533 LIST *arith(LIST *op, LIST *x, LIST *y)
ohneta 0:e9a7a38d9ad3 534 {
ohneta 0:e9a7a38d9ad3 535 LIST *p;
ohneta 0:e9a7a38d9ad3 536 float res = 0;
ohneta 0:e9a7a38d9ad3 537 int t = type(op);
ohneta 0:e9a7a38d9ad3 538
ohneta 0:e9a7a38d9ad3 539 if (t == LESSP) {
ohneta 0:e9a7a38d9ad3 540 return (x->u.num < y->u.num) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 541 }
ohneta 0:e9a7a38d9ad3 542 if (t == GREATERP) {
ohneta 0:e9a7a38d9ad3 543 return (x->u.num > y->u.num) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 544 }
ohneta 0:e9a7a38d9ad3 545
ohneta 0:e9a7a38d9ad3 546 switch (t) {
ohneta 0:e9a7a38d9ad3 547 case PLUS:
ohneta 0:e9a7a38d9ad3 548 res = x->u.num + y->u.num;
ohneta 0:e9a7a38d9ad3 549 break;
ohneta 0:e9a7a38d9ad3 550 case DIFF:
ohneta 0:e9a7a38d9ad3 551 res = x->u.num - y->u.num;
ohneta 0:e9a7a38d9ad3 552 break;
ohneta 0:e9a7a38d9ad3 553 case TIMES:
ohneta 0:e9a7a38d9ad3 554 res = x->u.num * y->u.num;
ohneta 0:e9a7a38d9ad3 555 break;
ohneta 0:e9a7a38d9ad3 556 case QUOTIENT:
ohneta 0:e9a7a38d9ad3 557 res = x->u.num / y->u.num;
ohneta 0:e9a7a38d9ad3 558 break;
ohneta 0:e9a7a38d9ad3 559 case ADD1:
ohneta 0:e9a7a38d9ad3 560 res = x->u.num + 1;
ohneta 0:e9a7a38d9ad3 561 break;
ohneta 0:e9a7a38d9ad3 562 case SUB1:
ohneta 0:e9a7a38d9ad3 563 res = x->u.num - 1;
ohneta 0:e9a7a38d9ad3 564 break;
ohneta 0:e9a7a38d9ad3 565 }
ohneta 0:e9a7a38d9ad3 566
ohneta 0:e9a7a38d9ad3 567 p = cons(NULL, NULL);
ohneta 0:e9a7a38d9ad3 568
ohneta 0:e9a7a38d9ad3 569 // @TODO: tがADD1かSUB1の場合、yは必ずNULLなので、 type(y)を実行するとエラーだと思うんだが...
ohneta 0:e9a7a38d9ad3 570 /*
ohneta 0:e9a7a38d9ad3 571 if ( (type(x) == IATOM) &&
ohneta 0:e9a7a38d9ad3 572 (type(y) == IATOM) ||
ohneta 0:e9a7a38d9ad3 573 (t == ADD1) || (t == SUB1) )
ohneta 0:e9a7a38d9ad3 574 ) {
ohneta 0:e9a7a38d9ad3 575 */
ohneta 0:e9a7a38d9ad3 576 if ((type(x) == IATOM) && ((t == ADD1) || (t == SUB1))) {
ohneta 0:e9a7a38d9ad3 577 p->u.num = (int)res;
ohneta 0:e9a7a38d9ad3 578 rplact(p, IATOM);
ohneta 0:e9a7a38d9ad3 579 } else {
ohneta 0:e9a7a38d9ad3 580 p->u.num = res;
ohneta 0:e9a7a38d9ad3 581 rplact(p, RATOM);
ohneta 0:e9a7a38d9ad3 582 }
ohneta 0:e9a7a38d9ad3 583
ohneta 0:e9a7a38d9ad3 584 return p;
ohneta 0:e9a7a38d9ad3 585 }
ohneta 0:e9a7a38d9ad3 586
ohneta 0:e9a7a38d9ad3 587 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 588 // input functions
ohneta 0:e9a7a38d9ad3 589 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 590
ohneta 0:e9a7a38d9ad3 591 // advance - skips white space in input file
ohneta 0:e9a7a38d9ad3 592 int advance()
ohneta 0:e9a7a38d9ad3 593 {
ohneta 0:e9a7a38d9ad3 594 int c;
ohneta 0:e9a7a38d9ad3 595 #if 0
ohneta 0:e9a7a38d9ad3 596 while (((c = getc_mine(fd)) != EOF) && (strchr(" \t\n", c) != NULL));
ohneta 0:e9a7a38d9ad3 597 #else
ohneta 0:e9a7a38d9ad3 598 while (1) {
ohneta 0:e9a7a38d9ad3 599 c = getc_mine(fd);
ohneta 0:e9a7a38d9ad3 600 if (c == EOF) {
ohneta 0:e9a7a38d9ad3 601 break;
ohneta 0:e9a7a38d9ad3 602 }
ohneta 0:e9a7a38d9ad3 603 if (strchr(" \t\n\r", c) == NULL) {
ohneta 0:e9a7a38d9ad3 604 break;
ohneta 0:e9a7a38d9ad3 605 }
ohneta 0:e9a7a38d9ad3 606 }
ohneta 0:e9a7a38d9ad3 607 #endif
ohneta 0:e9a7a38d9ad3 608 ungetc_mine(c, fd);
ohneta 0:e9a7a38d9ad3 609 //pc.printf("%c", c);
ohneta 0:e9a7a38d9ad3 610
ohneta 0:e9a7a38d9ad3 611 return c;
ohneta 0:e9a7a38d9ad3 612 }
ohneta 0:e9a7a38d9ad3 613
ohneta 0:e9a7a38d9ad3 614 LIST *lookup(LIST *head, char *name)
ohneta 0:e9a7a38d9ad3 615 {
ohneta 0:e9a7a38d9ad3 616 LIST *p;
ohneta 0:e9a7a38d9ad3 617
ohneta 0:e9a7a38d9ad3 618 #if 0
ohneta 0:e9a7a38d9ad3 619 for (p = head; p != NULL && strcmp(name, getname(car(p))); p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 620 ;
ohneta 0:e9a7a38d9ad3 621 }
ohneta 0:e9a7a38d9ad3 622 #else
ohneta 0:e9a7a38d9ad3 623 p = head;
ohneta 0:e9a7a38d9ad3 624 while (p != NULL) {
ohneta 0:e9a7a38d9ad3 625 if (strcmp(name, getname(car(p))) == 0) {
ohneta 0:e9a7a38d9ad3 626 break;
ohneta 0:e9a7a38d9ad3 627 }
ohneta 0:e9a7a38d9ad3 628 p = cdr(p);
ohneta 0:e9a7a38d9ad3 629 }
ohneta 0:e9a7a38d9ad3 630 #endif
ohneta 0:e9a7a38d9ad3 631
ohneta 0:e9a7a38d9ad3 632 return ((p == NULL) ? NULL : car(p));
ohneta 0:e9a7a38d9ad3 633 }
ohneta 0:e9a7a38d9ad3 634
ohneta 1:a2955606adef 635 /**
ohneta 1:a2955606adef 636 * nameをalistに加える
ohneta 1:a2955606adef 637 *
ohneta 1:a2955606adef 638 * @param char *name alistに加える名前
ohneta 1:a2955606adef 639 * @param bool nameCopyFlag nameをコピーするか否か。 true=コピーする、1=コピーしない(nameがconstな文字列)
ohneta 1:a2955606adef 640 */
ohneta 1:a2955606adef 641 LIST *install(char *name, bool nameCopyFlag = true)
ohneta 0:e9a7a38d9ad3 642 {
ohneta 1:a2955606adef 643 LIST *p = cons(NULL, NULL);
ohneta 0:e9a7a38d9ad3 644
ohneta 1:a2955606adef 645 if (nameCopyFlag) {
ohneta 1:a2955606adef 646 p->u.pname = (char *)emalloc(strlen(name) + 1);
ohneta 1:a2955606adef 647 strcpy(p->u.pname, name);
ohneta 1:a2955606adef 648 } else {
ohneta 1:a2955606adef 649 p->u.pname = name;
ohneta 1:a2955606adef 650 }
ohneta 1:a2955606adef 651
ohneta 0:e9a7a38d9ad3 652 rplact(p, VARI);
ohneta 0:e9a7a38d9ad3 653 g_alist = cons(p, g_alist);
ohneta 0:e9a7a38d9ad3 654
ohneta 0:e9a7a38d9ad3 655 return p;
ohneta 0:e9a7a38d9ad3 656 }
ohneta 0:e9a7a38d9ad3 657
ohneta 0:e9a7a38d9ad3 658 LIST *getnum()
ohneta 0:e9a7a38d9ad3 659 {
ohneta 0:e9a7a38d9ad3 660 LIST *p;
ohneta 0:e9a7a38d9ad3 661 float sum, n;
ohneta 0:e9a7a38d9ad3 662 int c;
ohneta 0:e9a7a38d9ad3 663
ohneta 0:e9a7a38d9ad3 664 sum = 0.0;
ohneta 0:e9a7a38d9ad3 665 p = cons(NULL, NULL);
ohneta 0:e9a7a38d9ad3 666 rplact(p, IATOM);
ohneta 0:e9a7a38d9ad3 667
ohneta 0:e9a7a38d9ad3 668 while (isdigit(c = getc_mine(fd))) {
ohneta 0:e9a7a38d9ad3 669 sum = sum * 10 + c - '0';
ohneta 0:e9a7a38d9ad3 670 }
ohneta 0:e9a7a38d9ad3 671
ohneta 0:e9a7a38d9ad3 672 if (c == '.') { /* the number is real */
ohneta 0:e9a7a38d9ad3 673 n = 10;
ohneta 0:e9a7a38d9ad3 674 rplact(p, RATOM);
ohneta 0:e9a7a38d9ad3 675 //while (isdigit(c = getc(fd))) {
ohneta 0:e9a7a38d9ad3 676 while (isdigit(c = getc_mine(fd))) {
ohneta 0:e9a7a38d9ad3 677 sum += (c - '0')/n;
ohneta 0:e9a7a38d9ad3 678 n *= 10;
ohneta 0:e9a7a38d9ad3 679 }
ohneta 0:e9a7a38d9ad3 680 }
ohneta 0:e9a7a38d9ad3 681
ohneta 0:e9a7a38d9ad3 682 ungetc_mine(c, fd);
ohneta 0:e9a7a38d9ad3 683 p->u.num = sum;
ohneta 0:e9a7a38d9ad3 684
ohneta 0:e9a7a38d9ad3 685 return p;
ohneta 0:e9a7a38d9ad3 686 }
ohneta 0:e9a7a38d9ad3 687
ohneta 0:e9a7a38d9ad3 688 LIST *getid()
ohneta 0:e9a7a38d9ad3 689 {
ohneta 0:e9a7a38d9ad3 690 LIST *p;
ohneta 0:e9a7a38d9ad3 691
ohneta 1:a2955606adef 692 char inbuf[120]; // トークン　１つ分のバッファ
ohneta 0:e9a7a38d9ad3 693 char *s = inbuf;
ohneta 0:e9a7a38d9ad3 694 LIST *idptr;
ohneta 0:e9a7a38d9ad3 695
ohneta 1:a2955606adef 696 // トークンを取得する
ohneta 1:a2955606adef 697 {
ohneta 1:a2955606adef 698 int c = getc_mine(fd);
ohneta 1:a2955606adef 699 *s = c;
ohneta 1:a2955606adef 700 s++;
ohneta 1:a2955606adef 701 if (c != '\'') {
ohneta 1:a2955606adef 702 while(1) {
ohneta 1:a2955606adef 703 c = getc_mine(fd);
ohneta 1:a2955606adef 704 if (!isalnum(c)) {
ohneta 1:a2955606adef 705 ungetc_mine(c, fd);
ohneta 1:a2955606adef 706 break;
ohneta 1:a2955606adef 707 }
ohneta 1:a2955606adef 708 *s = c;
ohneta 1:a2955606adef 709 s++;
ohneta 0:e9a7a38d9ad3 710 }
ohneta 0:e9a7a38d9ad3 711 }
ohneta 1:a2955606adef 712 *s = '\0';
ohneta 0:e9a7a38d9ad3 713 }
ohneta 0:e9a7a38d9ad3 714
ohneta 0:e9a7a38d9ad3 715 if ((idptr = lookup(g_oblist, inbuf)) == NULL) { // not a LISP function
ohneta 0:e9a7a38d9ad3 716 if ((idptr = lookup(g_alist, inbuf)) == NULL) { // id not declared yet
ohneta 1:a2955606adef 717 idptr = install(inbuf, true); // install it in g_alist (alist)
ohneta 0:e9a7a38d9ad3 718 }
ohneta 0:e9a7a38d9ad3 719 }
ohneta 0:e9a7a38d9ad3 720 p = cons(idptr, NULL);
ohneta 0:e9a7a38d9ad3 721 rplact(p, type(idptr));
ohneta 0:e9a7a38d9ad3 722
ohneta 0:e9a7a38d9ad3 723 return p;
ohneta 0:e9a7a38d9ad3 724 }
ohneta 0:e9a7a38d9ad3 725
ohneta 0:e9a7a38d9ad3 726 int gettok()
ohneta 0:e9a7a38d9ad3 727 {
ohneta 0:e9a7a38d9ad3 728 int c;
ohneta 0:e9a7a38d9ad3 729
ohneta 0:e9a7a38d9ad3 730 while ((c = advance()) == ';') { // saw a comment
ohneta 0:e9a7a38d9ad3 731 while (1) {
ohneta 0:e9a7a38d9ad3 732 c = getc_mine(fd);
ohneta 0:e9a7a38d9ad3 733 if ((c == EOF) || (c == '\n')) { // EOF or CR
ohneta 0:e9a7a38d9ad3 734 break;
ohneta 0:e9a7a38d9ad3 735 }
ohneta 0:e9a7a38d9ad3 736 }
ohneta 0:e9a7a38d9ad3 737 }
ohneta 0:e9a7a38d9ad3 738
ohneta 0:e9a7a38d9ad3 739 if (isalpha(c)) {
ohneta 0:e9a7a38d9ad3 740 return LETTER;
ohneta 0:e9a7a38d9ad3 741 }
ohneta 0:e9a7a38d9ad3 742 if (isdigit(c)) {
ohneta 0:e9a7a38d9ad3 743 return DIGIT;
ohneta 0:e9a7a38d9ad3 744 }
ohneta 0:e9a7a38d9ad3 745 switch (c) {
ohneta 0:e9a7a38d9ad3 746 case '(':
ohneta 0:e9a7a38d9ad3 747 return LPAREN;
ohneta 0:e9a7a38d9ad3 748 case ')':
ohneta 0:e9a7a38d9ad3 749 return RPAREN;
ohneta 0:e9a7a38d9ad3 750 case '\'':
ohneta 0:e9a7a38d9ad3 751 return INQUOTE;
ohneta 0:e9a7a38d9ad3 752 case EOF:
ohneta 0:e9a7a38d9ad3 753 return EOF;
ohneta 0:e9a7a38d9ad3 754 }
ohneta 0:e9a7a38d9ad3 755
ohneta 0:e9a7a38d9ad3 756 return ERR;
ohneta 0:e9a7a38d9ad3 757 }
ohneta 0:e9a7a38d9ad3 758
ohneta 0:e9a7a38d9ad3 759 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 760 // LISP primitive functions
ohneta 0:e9a7a38d9ad3 761 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 762
ohneta 0:e9a7a38d9ad3 763 // new - gets a new node from the free storage
ohneta 0:e9a7a38d9ad3 764 LIST *new_malisp()
ohneta 0:e9a7a38d9ad3 765 {
ohneta 0:e9a7a38d9ad3 766 LIST *p = (struct LIST *)emalloc(sizeof(LIST));
ohneta 0:e9a7a38d9ad3 767 p->gcbit = RUNNING;
ohneta 0:e9a7a38d9ad3 768
ohneta 0:e9a7a38d9ad3 769 return p;
ohneta 0:e9a7a38d9ad3 770 }
ohneta 0:e9a7a38d9ad3 771
ohneta 0:e9a7a38d9ad3 772 int type(LIST *p)
ohneta 0:e9a7a38d9ad3 773 {
ohneta 0:e9a7a38d9ad3 774 return p->htype;
ohneta 0:e9a7a38d9ad3 775 }
ohneta 0:e9a7a38d9ad3 776
ohneta 0:e9a7a38d9ad3 777 char* getname(LIST *p)
ohneta 0:e9a7a38d9ad3 778 {
ohneta 0:e9a7a38d9ad3 779 return (p == NULL) ? NULL : p->u.pname;
ohneta 0:e9a7a38d9ad3 780 }
ohneta 0:e9a7a38d9ad3 781
ohneta 0:e9a7a38d9ad3 782 // pのcar部をqに置き換える
ohneta 0:e9a7a38d9ad3 783 void rplaca(LIST *p, LIST *q)
ohneta 0:e9a7a38d9ad3 784 {
ohneta 0:e9a7a38d9ad3 785 p->left = q;
ohneta 0:e9a7a38d9ad3 786 }
ohneta 0:e9a7a38d9ad3 787
ohneta 0:e9a7a38d9ad3 788 // pのcdr部をqに置き換える
ohneta 0:e9a7a38d9ad3 789 void rplacd(LIST *p, LIST *q)
ohneta 0:e9a7a38d9ad3 790 {
ohneta 0:e9a7a38d9ad3 791 p->right = q;
ohneta 0:e9a7a38d9ad3 792 }
ohneta 0:e9a7a38d9ad3 793
ohneta 0:e9a7a38d9ad3 794 // pのタイプ(htype)をtに置き換える
ohneta 0:e9a7a38d9ad3 795 void rplact(LIST *p, int t)
ohneta 0:e9a7a38d9ad3 796 {
ohneta 0:e9a7a38d9ad3 797 p->htype = t;
ohneta 0:e9a7a38d9ad3 798 }
ohneta 0:e9a7a38d9ad3 799
ohneta 0:e9a7a38d9ad3 800 LIST *car(LIST *p)
ohneta 0:e9a7a38d9ad3 801 {
ohneta 0:e9a7a38d9ad3 802 return (p == NULL) ? NULL : p->left;
ohneta 0:e9a7a38d9ad3 803 }
ohneta 0:e9a7a38d9ad3 804
ohneta 0:e9a7a38d9ad3 805 LIST *cdr(LIST *p)
ohneta 0:e9a7a38d9ad3 806 {
ohneta 0:e9a7a38d9ad3 807 return (p == NULL) ? NULL : p->right;
ohneta 0:e9a7a38d9ad3 808 }
ohneta 0:e9a7a38d9ad3 809
ohneta 0:e9a7a38d9ad3 810 LIST *cons(LIST *p, LIST *q)
ohneta 0:e9a7a38d9ad3 811 {
ohneta 0:e9a7a38d9ad3 812 LIST *x = new_malisp();
ohneta 0:e9a7a38d9ad3 813
ohneta 0:e9a7a38d9ad3 814 rplaca(x, p);
ohneta 0:e9a7a38d9ad3 815 rplacd(x, q);
ohneta 0:e9a7a38d9ad3 816 rplact(x, LST);
ohneta 0:e9a7a38d9ad3 817
ohneta 0:e9a7a38d9ad3 818 return x;
ohneta 0:e9a7a38d9ad3 819 }
ohneta 0:e9a7a38d9ad3 820
ohneta 0:e9a7a38d9ad3 821 LIST *eq(LIST *x, LIST *y)
ohneta 0:e9a7a38d9ad3 822 {
ohneta 0:e9a7a38d9ad3 823 if (x == NULL || y == NULL) {
ohneta 0:e9a7a38d9ad3 824 if (x == y) {
ohneta 0:e9a7a38d9ad3 825 return TRU;
ohneta 0:e9a7a38d9ad3 826 }
ohneta 1:a2955606adef 827 } else if ( (type(x) == SATOM) &&
ohneta 1:a2955606adef 828 (type(y) == SATOM) &&
ohneta 1:a2955606adef 829 (car(x) == car(y)) ) {
ohneta 0:e9a7a38d9ad3 830 return TRU;
ohneta 0:e9a7a38d9ad3 831 }
ohneta 0:e9a7a38d9ad3 832
ohneta 0:e9a7a38d9ad3 833 return NULL;
ohneta 0:e9a7a38d9ad3 834 }
ohneta 0:e9a7a38d9ad3 835
ohneta 0:e9a7a38d9ad3 836 LIST *atom(LIST *x)
ohneta 0:e9a7a38d9ad3 837 {
ohneta 1:a2955606adef 838 #if 0
ohneta 0:e9a7a38d9ad3 839 int typ;
ohneta 0:e9a7a38d9ad3 840
ohneta 0:e9a7a38d9ad3 841 if (x == NULL || (typ = type(x)) == IATOM || typ == RATOM || typ == SATOM) {
ohneta 0:e9a7a38d9ad3 842 return TRU;
ohneta 0:e9a7a38d9ad3 843 }
ohneta 1:a2955606adef 844 #else
ohneta 1:a2955606adef 845 if (x == NULL) {
ohneta 1:a2955606adef 846 return TRU;
ohneta 1:a2955606adef 847 }
ohneta 1:a2955606adef 848
ohneta 1:a2955606adef 849 int typ = type(x);
ohneta 1:a2955606adef 850 if (typ == IATOM) {
ohneta 1:a2955606adef 851 return TRU;
ohneta 1:a2955606adef 852 }
ohneta 1:a2955606adef 853 if (typ == RATOM) {
ohneta 1:a2955606adef 854 return TRU;
ohneta 1:a2955606adef 855 }
ohneta 1:a2955606adef 856 if (typ == SATOM) {
ohneta 1:a2955606adef 857 return TRU;
ohneta 1:a2955606adef 858 }
ohneta 1:a2955606adef 859 #endif
ohneta 0:e9a7a38d9ad3 860 return NULL;
ohneta 0:e9a7a38d9ad3 861 }
ohneta 0:e9a7a38d9ad3 862
ohneta 0:e9a7a38d9ad3 863 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 864 // logical connectives - and, or, not
ohneta 0:e9a7a38d9ad3 865
ohneta 0:e9a7a38d9ad3 866 LIST *_and(LIST *x)
ohneta 0:e9a7a38d9ad3 867 {
ohneta 0:e9a7a38d9ad3 868 LIST *p;
ohneta 0:e9a7a38d9ad3 869 for (p = cdr(x); p != NULL; p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 870 if (eval(car(p), NULL) == NULL) {
ohneta 0:e9a7a38d9ad3 871 return NULL;
ohneta 0:e9a7a38d9ad3 872 }
ohneta 0:e9a7a38d9ad3 873 }
ohneta 0:e9a7a38d9ad3 874
ohneta 0:e9a7a38d9ad3 875 return TRU;
ohneta 0:e9a7a38d9ad3 876 }
ohneta 0:e9a7a38d9ad3 877
ohneta 0:e9a7a38d9ad3 878 LIST *_or(LIST *x)
ohneta 0:e9a7a38d9ad3 879 {
ohneta 0:e9a7a38d9ad3 880 LIST *p;
ohneta 0:e9a7a38d9ad3 881 for (p = cdr(x); p != NULL; p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 882 if (eval(car(p), NULL) != NULL) {
ohneta 0:e9a7a38d9ad3 883 return TRU;
ohneta 0:e9a7a38d9ad3 884 }
ohneta 0:e9a7a38d9ad3 885 }
ohneta 0:e9a7a38d9ad3 886
ohneta 0:e9a7a38d9ad3 887 return NULL;
ohneta 0:e9a7a38d9ad3 888 }
ohneta 0:e9a7a38d9ad3 889
ohneta 0:e9a7a38d9ad3 890 LIST *_not(LIST *x)
ohneta 0:e9a7a38d9ad3 891 {
ohneta 0:e9a7a38d9ad3 892 return (eval(cdr(x), NULL) == NULL) ? TRU : NULL;
ohneta 0:e9a7a38d9ad3 893 }
ohneta 0:e9a7a38d9ad3 894
ohneta 0:e9a7a38d9ad3 895 // other primitives
ohneta 0:e9a7a38d9ad3 896
ohneta 0:e9a7a38d9ad3 897 LIST *_list(LIST *x)
ohneta 0:e9a7a38d9ad3 898 {
ohneta 0:e9a7a38d9ad3 899 LIST *res, *p;
ohneta 0:e9a7a38d9ad3 900
ohneta 0:e9a7a38d9ad3 901 for (res = NULL, p = cdr(x); p != NULL; p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 902 res = cons(res, car(p));
ohneta 0:e9a7a38d9ad3 903 }
ohneta 0:e9a7a38d9ad3 904
ohneta 0:e9a7a38d9ad3 905 return res;
ohneta 0:e9a7a38d9ad3 906 }
ohneta 0:e9a7a38d9ad3 907
ohneta 0:e9a7a38d9ad3 908
ohneta 0:e9a7a38d9ad3 909 void var_to_user(LIST *p)
ohneta 0:e9a7a38d9ad3 910 {
ohneta 0:e9a7a38d9ad3 911 if (p == NULL) {
ohneta 0:e9a7a38d9ad3 912 return;
ohneta 0:e9a7a38d9ad3 913 }
ohneta 0:e9a7a38d9ad3 914
ohneta 0:e9a7a38d9ad3 915 if (type(p) == VARI) {
ohneta 0:e9a7a38d9ad3 916 if (type(car(p)) == FUSER) {
ohneta 0:e9a7a38d9ad3 917 rplact(p, FUSER);
ohneta 0:e9a7a38d9ad3 918 }
ohneta 0:e9a7a38d9ad3 919 } else if (type(p) == LST) {
ohneta 0:e9a7a38d9ad3 920 var_to_user(car(p));
ohneta 0:e9a7a38d9ad3 921 var_to_user(cdr(p));
ohneta 0:e9a7a38d9ad3 922 }
ohneta 0:e9a7a38d9ad3 923 }
ohneta 0:e9a7a38d9ad3 924
ohneta 0:e9a7a38d9ad3 925 void var_to_atom(LIST *p)
ohneta 0:e9a7a38d9ad3 926 {
ohneta 0:e9a7a38d9ad3 927 int t;
ohneta 0:e9a7a38d9ad3 928
ohneta 0:e9a7a38d9ad3 929 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 930 if (((t = type(p)) != LST && !isfunc(t)) || t == FUSER) {
ohneta 0:e9a7a38d9ad3 931 rplact(p, SATOM);
ohneta 0:e9a7a38d9ad3 932 } else {
ohneta 0:e9a7a38d9ad3 933 var_to_atom(car(p)); var_to_atom(cdr(p));
ohneta 0:e9a7a38d9ad3 934 }
ohneta 0:e9a7a38d9ad3 935 }
ohneta 0:e9a7a38d9ad3 936 }
ohneta 0:e9a7a38d9ad3 937
ohneta 0:e9a7a38d9ad3 938 // find_labels - change the type of all labels in a PROG to LABL
ohneta 0:e9a7a38d9ad3 939 void find_labels(LIST *p)
ohneta 0:e9a7a38d9ad3 940 {
ohneta 0:e9a7a38d9ad3 941 for ( ; p != NULL; p = cdr(p)) {
ohneta 0:e9a7a38d9ad3 942 if (type(car(p)) == VARI) {
ohneta 0:e9a7a38d9ad3 943 rplact(car(p), LABL); // change the type to LABL
ohneta 0:e9a7a38d9ad3 944 rplacd(car(car(p)), cdr(p)); // label points to next statement
ohneta 0:e9a7a38d9ad3 945 }
ohneta 0:e9a7a38d9ad3 946 }
ohneta 0:e9a7a38d9ad3 947 }
ohneta 0:e9a7a38d9ad3 948
ohneta 0:e9a7a38d9ad3 949 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 950 // garbage collection
ohneta 0:e9a7a38d9ad3 951 //----------------------------------------------------------------
ohneta 0:e9a7a38d9ad3 952
ohneta 0:e9a7a38d9ad3 953 void work_garbageCollect(LIST *p)
ohneta 0:e9a7a38d9ad3 954 {
ohneta 0:e9a7a38d9ad3 955 int cnt = 0;
ohneta 0:e9a7a38d9ad3 956 while (p != NULL) {
ohneta 0:e9a7a38d9ad3 957
ohneta 0:e9a7a38d9ad3 958 int t = type(p);
ohneta 0:e9a7a38d9ad3 959
ohneta 0:e9a7a38d9ad3 960 pc.printf("[%d] ", cnt);
ohneta 0:e9a7a38d9ad3 961 pc.printf("(%d) ", t);
ohneta 0:e9a7a38d9ad3 962 if ((t == IATOM) || (t == RATOM)) {
ohneta 0:e9a7a38d9ad3 963 pc.printf("[%f ] : ", p->u.num);
ohneta 0:e9a7a38d9ad3 964 } else if (t == SATOM) {
ohneta 0:e9a7a38d9ad3 965 pc.printf("[%s ] : ", p->u.pname);
ohneta 0:e9a7a38d9ad3 966 } else {
ohneta 0:e9a7a38d9ad3 967 pc.printf(" : ");
ohneta 0:e9a7a38d9ad3 968 }
ohneta 0:e9a7a38d9ad3 969
ohneta 1:a2955606adef 970 //pc.printf("%d : ", (p->gcbit >> 16) & 0xff); // num
ohneta 1:a2955606adef 971 //pc.printf("%d \n", (p->gcbit & 0xff)); // bit (USED/RUNNING)
ohneta 0:e9a7a38d9ad3 972
ohneta 0:e9a7a38d9ad3 973 p = cdr(p);
ohneta 0:e9a7a38d9ad3 974 cnt++;
ohneta 0:e9a7a38d9ad3 975 }
ohneta 0:e9a7a38d9ad3 976 }
ohneta 0:e9a7a38d9ad3 977
ohneta 0:e9a7a38d9ad3 978 // marktree - recursively marks all used items in a list
ohneta 0:e9a7a38d9ad3 979 void marktree(LIST *p)
ohneta 0:e9a7a38d9ad3 980 {
ohneta 0:e9a7a38d9ad3 981 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 982 if (type(p) == LST) {
ohneta 0:e9a7a38d9ad3 983 marktree(car(p));
ohneta 0:e9a7a38d9ad3 984 marktree(cdr(p));
ohneta 0:e9a7a38d9ad3 985 }
ohneta 0:e9a7a38d9ad3 986 p->gcbit = USED;
ohneta 0:e9a7a38d9ad3 987 }
ohneta 0:e9a7a38d9ad3 988 }
ohneta 0:e9a7a38d9ad3 989
ohneta 0:e9a7a38d9ad3 990 /*********************** storage allocator *****************/
ohneta 0:e9a7a38d9ad3 991
ohneta 0:e9a7a38d9ad3 992 void *emalloc(size_t size)
ohneta 0:e9a7a38d9ad3 993 {
ohneta 0:e9a7a38d9ad3 994 void *s;
ohneta 0:e9a7a38d9ad3 995
ohneta 0:e9a7a38d9ad3 996 if ((s = malloc(size)) == NULL) {
ohneta 0:e9a7a38d9ad3 997 pc.printf("OUT OF MEMORY !! : crashed !! \n");
ohneta 0:e9a7a38d9ad3 998 exit(0);
ohneta 0:e9a7a38d9ad3 999 }
ohneta 0:e9a7a38d9ad3 1000
ohneta 0:e9a7a38d9ad3 1001 return s;
ohneta 0:e9a7a38d9ad3 1002 }
ohneta 0:e9a7a38d9ad3 1003
ohneta 0:e9a7a38d9ad3 1004 // routine to load the library of lisp functions in
ohneta 0:e9a7a38d9ad3 1005 void load_library(void)
ohneta 0:e9a7a38d9ad3 1006 {
ohneta 0:e9a7a38d9ad3 1007 #if 0
ohneta 0:e9a7a38d9ad3 1008 char libpath[1024];
ohneta 0:e9a7a38d9ad3 1009 strcpy(libpath, getenv("HOME"));
ohneta 0:e9a7a38d9ad3 1010 strcat(libpath, "/lisplib");
ohneta 0:e9a7a38d9ad3 1011
ohneta 0:e9a7a38d9ad3 1012 if ((fd = fopen(libpath, "r")) != NULL) {
ohneta 0:e9a7a38d9ad3 1013 interpret_malisp();
ohneta 0:e9a7a38d9ad3 1014 fclose(fd);
ohneta 0:e9a7a38d9ad3 1015
ohneta 0:e9a7a38d9ad3 1016 pc.printf("loaded lisplib from %s\n", libpath);
ohneta 0:e9a7a38d9ad3 1017 }
ohneta 0:e9a7a38d9ad3 1018 interpret_malisp();
ohneta 0:e9a7a38d9ad3 1019
ohneta 0:e9a7a38d9ad3 1020 fd = stdin;
ohneta 0:e9a7a38d9ad3 1021 #else
ohneta 0:e9a7a38d9ad3 1022
ohneta 0:e9a7a38d9ad3 1023 fd = FILE_STRING;
ohneta 0:e9a7a38d9ad3 1024 interpret_malisp();
ohneta 0:e9a7a38d9ad3 1025 pc.printf("loaded lisplib from flash\n");
ohneta 0:e9a7a38d9ad3 1026
ohneta 0:e9a7a38d9ad3 1027 fd = FILE_SERIAL;
ohneta 0:e9a7a38d9ad3 1028
ohneta 0:e9a7a38d9ad3 1029 #endif
ohneta 0:e9a7a38d9ad3 1030 }
ohneta 0:e9a7a38d9ad3 1031
ohneta 0:e9a7a38d9ad3 1032 // isfunc - returns YES if type t is a user-function or a lisp primitive
ohneta 0:e9a7a38d9ad3 1033 int isfunc(int t)
ohneta 0:e9a7a38d9ad3 1034 {
ohneta 0:e9a7a38d9ad3 1035 return
ohneta 0:e9a7a38d9ad3 1036 ( t==FUSER || t==ADD1 || t==SUB1 || t==PLUS || t==DIFF || t==TIMES ||
ohneta 0:e9a7a38d9ad3 1037 t==QUOTIENT || t==LESSP || t==GREATERP || t==ZEROP || t==NUMBERP ||
ohneta 0:e9a7a38d9ad3 1038 t==FCAR || t==FCDR || t==FCONS || t==FREAD || t==PRINT || t==FNOT||
ohneta 0:e9a7a38d9ad3 1039 t==FAND || t==FOR || t==FEVAL || t==FEQ || t==FATOM ||
ohneta 0:e9a7a38d9ad3 1040
ohneta 0:e9a7a38d9ad3 1041 // mbed extends
ohneta 0:e9a7a38d9ad3 1042 t == FFREEMEM || t == FWAIT || t == FDOUT || t == FDIN ||
ohneta 0:e9a7a38d9ad3 1043 t == FAOUT || t == FAIN || t == PWMOUT
ohneta 0:e9a7a38d9ad3 1044 );
ohneta 0:e9a7a38d9ad3 1045 }
ohneta 0:e9a7a38d9ad3 1046
ohneta 0:e9a7a38d9ad3 1047 void debug(LIST *p)
ohneta 0:e9a7a38d9ad3 1048 {
ohneta 0:e9a7a38d9ad3 1049 pc.printf("DEBUG ---\n");
ohneta 0:e9a7a38d9ad3 1050 debug2(p);
ohneta 0:e9a7a38d9ad3 1051 pc.printf("\n");
ohneta 0:e9a7a38d9ad3 1052 }
ohneta 0:e9a7a38d9ad3 1053
ohneta 0:e9a7a38d9ad3 1054 void debug2(LIST *p)
ohneta 0:e9a7a38d9ad3 1055 {
ohneta 0:e9a7a38d9ad3 1056 int t;
ohneta 0:e9a7a38d9ad3 1057
ohneta 0:e9a7a38d9ad3 1058 if (p != NULL) {
ohneta 0:e9a7a38d9ad3 1059 if ((t = type(p)) == LST) {
ohneta 0:e9a7a38d9ad3 1060 pc.printf("(");
ohneta 0:e9a7a38d9ad3 1061 debug2(car(p));
ohneta 0:e9a7a38d9ad3 1062 debug2(cdr(p));
ohneta 0:e9a7a38d9ad3 1063 pc.printf(")");
ohneta 0:e9a7a38d9ad3 1064 } else if (t == RATOM) {
ohneta 0:e9a7a38d9ad3 1065 pc.printf("RATOM %f ", p->u.num);
ohneta 0:e9a7a38d9ad3 1066 } else if (t == IATOM) {
ohneta 0:e9a7a38d9ad3 1067 pc.printf("IATOM %d ", (int) p->u.num);
ohneta 0:e9a7a38d9ad3 1068 } else if (t == SATOM) {
ohneta 0:e9a7a38d9ad3 1069 pc.printf("SATOM %s ", getname(car(p)));
ohneta 0:e9a7a38d9ad3 1070 } else {
ohneta 0:e9a7a38d9ad3 1071 pc.printf("FUNC %d ", type(p));
ohneta 0:e9a7a38d9ad3 1072 }
ohneta 0:e9a7a38d9ad3 1073 }
ohneta 0:e9a7a38d9ad3 1074 }