Lisp Interpreter for mbed LPC1768
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?
User | Revision | Line number | New 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 | } |