git.gag.com Git - fw/altos/blob - src/lisp/ao_lisp_eval.c

   1 /*
   2  * Copyright © 2016 Keith Packard <keithp@keithp.com>
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful, but
  10  * WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12  * General Public License for more details.
  13  */
  14
  15 #define DBG_EVAL 0
  16 #include "ao_lisp.h"
  17 #include <assert.h>
  18
  19 const struct ao_lisp_type ao_lisp_stack_type;
  20
  21 static int
  22 stack_size(void *addr)
  23 {
  24         (void) addr;
  25         return sizeof (struct ao_lisp_stack);
  26 }
  27
  28 static void
  29 stack_mark(void *addr)
  30 {
  31         struct ao_lisp_stack    *stack = addr;
  32         for (;;) {
  33                 ao_lisp_poly_mark(stack->sexprs, 0);
  34                 ao_lisp_poly_mark(stack->values, 0);
  35                 /* no need to mark values_tail */
  36                 ao_lisp_poly_mark(stack->frame, 0);
  37                 ao_lisp_poly_mark(stack->list, 0);
  38                 stack = ao_lisp_poly_stack(stack->prev);
  39                 if (ao_lisp_mark_memory(&ao_lisp_stack_type, stack))
  40                         break;
  41         }
  42 }
  43
  44 static void
  45 stack_move(void *addr)
  46 {
  47         struct ao_lisp_stack    *stack = addr;
  48
  49         while (stack) {
  50                 struct ao_lisp_stack    *prev;
  51                 int                     ret;
  52                 (void) ao_lisp_poly_move(&stack->sexprs, 0);
  53                 (void) ao_lisp_poly_move(&stack->values, 0);
  54                 (void) ao_lisp_poly_move(&stack->values_tail, 0);
  55                 (void) ao_lisp_poly_move(&stack->frame, 0);
  56                 (void) ao_lisp_poly_move(&stack->list, 0);
  57                 prev = ao_lisp_poly_stack(stack->prev);
  58                 if (!prev)
  59                         break;
  60                 ret = ao_lisp_move_memory(&ao_lisp_stack_type, (void **) &prev);
  61                 if (prev != ao_lisp_poly_stack(stack->prev))
  62                         stack->prev = ao_lisp_stack_poly(prev);
  63                 if (ret)
  64                         break;
  65                 stack = prev;
  66         }
  67 }
  68
  69 const struct ao_lisp_type ao_lisp_stack_type = {
  70         .size = stack_size,
  71         .mark = stack_mark,
  72         .move = stack_move,
  73         .name = "stack"
  74 };
  75
  76 struct ao_lisp_stack            *ao_lisp_stack;
  77 ao_poly                         ao_lisp_v;
  78
  79 struct ao_lisp_stack            *ao_lisp_stack_free_list;
  80
  81 ao_poly
  82 ao_lisp_set_cond(struct ao_lisp_cons *c)
  83 {
  84         ao_lisp_stack->state = eval_cond;
  85         ao_lisp_stack->sexprs = ao_lisp_cons_poly(c);
  86         return AO_LISP_NIL;
  87 }
  88
  89 static void
  90 ao_lisp_stack_reset(struct ao_lisp_stack *stack)
  91 {
  92         stack->state = eval_sexpr;
  93         stack->sexprs = AO_LISP_NIL;
  94         stack->values = AO_LISP_NIL;
  95         stack->values_tail = AO_LISP_NIL;
  96 }
  97
  98
  99 static int
 100 ao_lisp_stack_push(void)
 101 {
 102         struct ao_lisp_stack    *stack;
 103         if (ao_lisp_stack_free_list) {
 104                 stack = ao_lisp_stack_free_list;
 105                 ao_lisp_stack_free_list = ao_lisp_poly_stack(stack->prev);
 106         } else {
 107                 stack = ao_lisp_alloc(sizeof (struct ao_lisp_stack));
 108                 if (!stack)
 109                         return 0;
 110         }
 111         stack->prev = ao_lisp_stack_poly(ao_lisp_stack);
 112         stack->frame = ao_lisp_frame_poly(ao_lisp_frame_current);
 113         stack->list = AO_LISP_NIL;
 114         ao_lisp_stack = stack;
 115         ao_lisp_stack_reset(stack);
 116         DBGI("stack push\n");
 117         DBG_FRAMES();
 118         DBG_IN();
 119         return 1;
 120 }
 121
 122 static void
 123 ao_lisp_stack_pop(void)
 124 {
 125         ao_poly                 prev;
 126         struct ao_lisp_frame    *prev_frame;
 127
 128         if (!ao_lisp_stack)
 129                 return;
 130         prev = ao_lisp_stack->prev;
 131         ao_lisp_stack->prev = ao_lisp_stack_poly(ao_lisp_stack_free_list);
 132         ao_lisp_stack_free_list = ao_lisp_stack;
 133
 134         ao_lisp_stack = ao_lisp_poly_stack(prev);
 135         prev_frame = ao_lisp_frame_current;
 136         if (ao_lisp_stack)
 137                 ao_lisp_frame_current = ao_lisp_poly_frame(ao_lisp_stack->frame);
 138         else
 139                 ao_lisp_frame_current = NULL;
 140         if (ao_lisp_frame_current != prev_frame)
 141                 ao_lisp_frame_free(prev_frame);
 142         DBG_OUT();
 143         DBGI("stack pop\n");
 144         DBG_FRAMES();
 145 }
 146
 147 static void
 148 ao_lisp_stack_clear(void)
 149 {
 150         ao_lisp_stack = NULL;
 151         ao_lisp_frame_current = NULL;
 152         ao_lisp_v = AO_LISP_NIL;
 153 }
 154
 155 static int
 156 func_type(ao_poly func)
 157 {
 158         if (func == AO_LISP_NIL)
 159                 return ao_lisp_error(AO_LISP_INVALID, "func is nil");
 160         switch (ao_lisp_poly_type(func)) {
 161         case AO_LISP_BUILTIN:
 162                 return ao_lisp_poly_builtin(func)->args & AO_LISP_FUNC_MASK;
 163         case AO_LISP_LAMBDA:
 164                 return ao_lisp_poly_lambda(func)->args;
 165         default:
 166                 ao_lisp_error(AO_LISP_INVALID, "not a func");
 167                 return -1;
 168         }
 169 }
 170
 171 /*
 172  * Flattened eval to avoid stack issues
 173  */
 174
 175 /*
 176  * Evaluate an s-expression
 177  *
 178  * For a list, evaluate all of the elements and
 179  * then execute the resulting function call.
 180  *
 181  * Each element of the list is evaluated in
 182  * a clean stack context.
 183  *
 184  * The current stack state is set to 'formal' so that
 185  * when the evaluation is complete, the value
 186  * will get appended to the values list.
 187  *
 188  * For other types, compute the value directly.
 189  */
 190
 191 static int
 192 ao_lisp_eval_sexpr(void)
 193 {
 194         DBGI("sexpr: "); DBG_POLY(ao_lisp_v); DBG("\n");
 195         switch (ao_lisp_poly_type(ao_lisp_v)) {
 196         case AO_LISP_CONS:
 197                 if (ao_lisp_v == AO_LISP_NIL) {
 198                         if (!ao_lisp_stack->values) {
 199                                 /*
 200                                  * empty list evaluates to empty list
 201                                  */
 202                                 ao_lisp_v = AO_LISP_NIL;
 203                                 ao_lisp_stack->state = eval_val;
 204                         } else {
 205                                 /*
 206                                  * done with arguments, go execute it
 207                                  */
 208                                 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->values)->car;
 209                                 ao_lisp_stack->state = eval_exec;
 210                         }
 211                 } else {
 212                         if (!ao_lisp_stack->values)
 213                                 ao_lisp_stack->list = ao_lisp_v;
 214                         /*
 215                          * Evaluate another argument and then switch
 216                          * to 'formal' to add the value to the values
 217                          * list
 218                          */
 219                         ao_lisp_stack->sexprs = ao_lisp_v;
 220                         ao_lisp_stack->state = eval_formal;
 221                         if (!ao_lisp_stack_push())
 222                                 return 0;
 223                         /*
 224                          * push will reset the state to 'sexpr', which
 225                          * will evaluate the expression
 226                          */
 227                         ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
 228                 }
 229                 break;
 230         case AO_LISP_ATOM:
 231                 DBGI("..frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 232                 ao_lisp_v = ao_lisp_atom_get(ao_lisp_v);
 233                 /* fall through */
 234         case AO_LISP_INT:
 235         case AO_LISP_STRING:
 236         case AO_LISP_BUILTIN:
 237         case AO_LISP_LAMBDA:
 238                 ao_lisp_stack->state = eval_val;
 239                 break;
 240         }
 241         DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG("\n");
 242         return 1;
 243 }
 244
 245 /*
 246  * A value has been computed.
 247  *
 248  * If the value was computed from a macro,
 249  * then we want to reset the current context
 250  * to evaluate the macro result again.
 251  *
 252  * If not a macro, then pop the stack.
 253  * If the stack is empty, we're done.
 254  * Otherwise, the stack will contain
 255  * the next state.
 256  */
 257
 258 static int
 259 ao_lisp_eval_val(void)
 260 {
 261         DBGI("val: "); DBG_POLY(ao_lisp_v); DBG("\n");
 262         /*
 263          * Value computed, pop the stack
 264          * to figure out what to do with the value
 265          */
 266         ao_lisp_stack_pop();
 267         DBGI("..state %d\n", ao_lisp_stack ? ao_lisp_stack->state : -1);
 268         return 1;
 269 }
 270
 271 /*
 272  * A formal has been computed.
 273  *
 274  * If this is the first formal, then check to see if we've got a
 275  * lamda/lexpr or macro/nlambda.
 276  *
 277  * For lambda/lexpr, go compute another formal.  This will terminate
 278  * when the sexpr state sees nil.
 279  *
 280  * For macro/nlambda, we're done, so move the sexprs into the values
 281  * and go execute it.
 282  *
 283  * Macros have an additional step of saving a stack frame holding the
 284  * macro value execution context, which then gets the result of the
 285  * macro to run
 286  */
 287
 288 static int
 289 ao_lisp_eval_formal(void)
 290 {
 291         ao_poly                 formal;
 292         struct ao_lisp_stack    *prev;
 293
 294         DBGI("formal: "); DBG_POLY(ao_lisp_v); DBG("\n");
 295
 296         /* Check what kind of function we've got */
 297         if (!ao_lisp_stack->values) {
 298                 switch (func_type(ao_lisp_v)) {
 299                 case AO_LISP_FUNC_LAMBDA:
 300                 case AO_LISP_FUNC_LEXPR:
 301                         DBGI(".. lambda or lexpr\n");
 302                         break;
 303                 case AO_LISP_FUNC_MACRO:
 304                         /* Evaluate the result once more */
 305                         ao_lisp_stack->state = eval_macro;
 306                         if (!ao_lisp_stack_push())
 307                                 return 0;
 308
 309                         /* After the function returns, take that
 310                          * value and re-evaluate it
 311                          */
 312                         prev = ao_lisp_poly_stack(ao_lisp_stack->prev);
 313                         ao_lisp_stack->sexprs = prev->sexprs;
 314
 315                         DBGI(".. start macro\n");
 316                         DBGI(".. sexprs       "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 317                         DBGI(".. values       "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
 318                         DBG_FRAMES();
 319
 320                         /* fall through ... */
 321                 case AO_LISP_FUNC_NLAMBDA:
 322                         DBGI(".. nlambda or macro\n");
 323
 324                         /* use the raw sexprs as values */
 325                         ao_lisp_stack->values = ao_lisp_stack->sexprs;
 326                         ao_lisp_stack->values_tail = AO_LISP_NIL;
 327                         ao_lisp_stack->state = eval_exec;
 328
 329                         /* ready to execute now */
 330                         return 1;
 331                 case -1:
 332                         return 0;
 333                 }
 334         }
 335
 336         /* Append formal to list of values */
 337         formal = ao_lisp_cons_poly(ao_lisp_cons_cons(ao_lisp_v, NULL));
 338         if (!formal)
 339                 return 0;
 340
 341         if (ao_lisp_stack->values_tail)
 342                 ao_lisp_poly_cons(ao_lisp_stack->values_tail)->cdr = formal;
 343         else
 344                 ao_lisp_stack->values = formal;
 345         ao_lisp_stack->values_tail = formal;
 346
 347         DBGI(".. values "); DBG_POLY(ao_lisp_stack->values); DBG("\n");
 348
 349         /*
 350          * Step to the next argument, if this is last, then
 351          * 'sexpr' will end up switching to 'exec'
 352          */
 353         ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
 354
 355         ao_lisp_stack->state = eval_sexpr;
 356
 357         DBGI(".. "); DBG_POLY(ao_lisp_v); DBG("\n");
 358         return 1;
 359 }
 360
 361 /*
 362  * Start executing a function call
 363  *
 364  * Most builtins are easy, just call the function.
 365  * 'cond' is magic; it sticks the list of clauses
 366  * in 'sexprs' and switches to 'cond' state. That
 367  * bit of magic is done in ao_lisp_set_cond.
 368  *
 369  * Lambdas build a new frame to hold the locals and
 370  * then re-use the current stack context to evaluate
 371  * the s-expression from the lambda.
 372  */
 373
 374 static int
 375 ao_lisp_eval_exec(void)
 376 {
 377         ao_poly v;
 378         struct ao_lisp_builtin  *builtin;
 379
 380         DBGI("exec: "); DBG_POLY(ao_lisp_v); DBG(" values "); DBG_POLY(ao_lisp_stack->values); DBG ("\n");
 381         ao_lisp_stack->sexprs = AO_LISP_NIL;
 382         switch (ao_lisp_poly_type(ao_lisp_v)) {
 383         case AO_LISP_BUILTIN:
 384                 ao_lisp_stack->state = eval_val;
 385                 builtin = ao_lisp_poly_builtin(ao_lisp_v);
 386                 v = ao_lisp_func(builtin) (
 387                         ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->values)->cdr));
 388                 DBG_DO(if (!ao_lisp_exception && ao_lisp_poly_builtin(ao_lisp_v)->func == builtin_set) {
 389                                 struct ao_lisp_cons *cons = ao_lisp_poly_cons(ao_lisp_stack->values);
 390                                 ao_poly atom = ao_lisp_arg(cons, 1);
 391                                 ao_poly val = ao_lisp_arg(cons, 2);
 392                                 DBGI("set "); DBG_POLY(atom); DBG(" = "); DBG_POLY(val); DBG("\n");
 393                         });
 394                 builtin = ao_lisp_poly_builtin(ao_lisp_v);
 395                 if (builtin->args & AO_LISP_FUNC_FREE_ARGS)
 396                         ao_lisp_cons_free(ao_lisp_poly_cons(ao_lisp_stack->values));
 397
 398                 ao_lisp_v = v;
 399                 DBGI(".. result "); DBG_POLY(ao_lisp_v); DBG ("\n");
 400                 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 401                 break;
 402         case AO_LISP_LAMBDA:
 403                 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 404                 ao_lisp_stack->state = eval_progn;
 405                 v = ao_lisp_lambda_eval();
 406                 ao_lisp_stack->sexprs = v;
 407                 DBGI(".. sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 408                 DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 409                 break;
 410         }
 411         ao_lisp_stack->values = AO_LISP_NIL;
 412         ao_lisp_stack->values_tail = AO_LISP_NIL;
 413         return 1;
 414 }
 415
 416 /*
 417  * Start evaluating the next cond clause
 418  *
 419  * If the list of clauses is empty, then
 420  * the result of the cond is nil.
 421  *
 422  * Otherwise, set the current stack state to 'cond_test' and create a
 423  * new stack context to evaluate the test s-expression. Once that's
 424  * complete, we'll land in 'cond_test' to finish the clause.
 425  */
 426 static int
 427 ao_lisp_eval_cond(void)
 428 {
 429         DBGI("cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 430         DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 431         DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
 432         if (!ao_lisp_stack->sexprs) {
 433                 ao_lisp_v = AO_LISP_NIL;
 434                 ao_lisp_stack->state = eval_val;
 435         } else {
 436                 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
 437                 if (!ao_lisp_v || ao_lisp_poly_type(ao_lisp_v) != AO_LISP_CONS) {
 438                         ao_lisp_error(AO_LISP_INVALID, "invalid cond clause");
 439                         return 0;
 440                 }
 441                 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_v)->car;
 442                 ao_lisp_stack->state = eval_cond_test;
 443                 if (!ao_lisp_stack_push())
 444                         return 0;
 445         }
 446         return 1;
 447 }
 448
 449 /*
 450  * Finish a cond clause.
 451  *
 452  * Check the value from the test expression, if
 453  * non-nil, then set up to evaluate the value expression.
 454  *
 455  * Otherwise, step to the next clause and go back to the 'cond'
 456  * state
 457  */
 458 static int
 459 ao_lisp_eval_cond_test(void)
 460 {
 461         DBGI("cond_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 462         DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 463         DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
 464         if (ao_lisp_v) {
 465                 struct ao_lisp_cons *car = ao_lisp_poly_cons(ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car);
 466                 ao_poly c = car->cdr;
 467
 468                 if (c) {
 469                         ao_lisp_stack->state = eval_progn;
 470                         ao_lisp_stack->sexprs = c;
 471                 } else
 472                         ao_lisp_stack->state = eval_val;
 473         } else {
 474                 ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
 475                 DBGI("next cond: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 476                 ao_lisp_stack->state = eval_cond;
 477         }
 478         return 1;
 479 }
 480
 481 /*
 482  * Evaluate a list of sexprs, returning the value from the last one.
 483  *
 484  * ao_lisp_progn records the list in stack->sexprs, so we just need to
 485  * walk that list. Set ao_lisp_v to the car of the list and jump to
 486  * eval_sexpr. When that's done, it will land in eval_val. For all but
 487  * the last, leave a stack frame with eval_progn set so that we come
 488  * back here. For the last, don't add a stack frame so that we can
 489  * just continue on.
 490  */
 491 static int
 492 ao_lisp_eval_progn(void)
 493 {
 494         DBGI("progn: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 495         DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 496         DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
 497
 498         if (!ao_lisp_stack->sexprs) {
 499                 ao_lisp_v = AO_LISP_NIL;
 500                 ao_lisp_stack->state = eval_val;
 501         } else {
 502                 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
 503                 ao_lisp_stack->sexprs = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
 504
 505                 /* If there are more sexprs to do, then come back here, otherwise
 506                  * return the value of the last one by just landing in eval_sexpr
 507                  */
 508                 if (ao_lisp_stack->sexprs) {
 509                         ao_lisp_stack->state = eval_progn;
 510                         if (!ao_lisp_stack_push())
 511                                 return 0;
 512                 }
 513                 ao_lisp_stack->state = eval_sexpr;
 514         }
 515         return 1;
 516 }
 517
 518 /*
 519  * Conditionally execute a list of sexprs while the first is true
 520  */
 521 static int
 522 ao_lisp_eval_while(void)
 523 {
 524         DBGI("while: "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 525         DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 526         DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
 527
 528         ao_lisp_stack->values = ao_lisp_v;
 529         if (!ao_lisp_stack->sexprs) {
 530                 ao_lisp_v = AO_LISP_NIL;
 531                 ao_lisp_stack->state = eval_val;
 532         } else {
 533                 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->car;
 534                 ao_lisp_stack->state = eval_while_test;
 535                 if (!ao_lisp_stack_push())
 536                         return 0;
 537         }
 538         return 1;
 539 }
 540
 541 /*
 542  * Check the while condition, terminate the loop if nil. Otherwise keep going
 543  */
 544 static int
 545 ao_lisp_eval_while_test(void)
 546 {
 547         DBGI("while_test: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 548         DBGI(".. frame "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");
 549         DBGI(".. saved frame "); DBG_POLY(ao_lisp_stack->frame); DBG("\n");
 550
 551         if (ao_lisp_v) {
 552                 ao_lisp_stack->values = ao_lisp_v;
 553                 ao_lisp_v = ao_lisp_poly_cons(ao_lisp_stack->sexprs)->cdr;
 554                 ao_lisp_stack->state = eval_while;
 555                 if (!ao_lisp_stack_push())
 556                         return 0;
 557                 ao_lisp_stack->state = eval_progn;
 558                 ao_lisp_stack->sexprs = ao_lisp_v;
 559         }
 560         else
 561         {
 562                 ao_lisp_stack->state = eval_val;
 563                 ao_lisp_v = ao_lisp_stack->values;
 564         }
 565         return 1;
 566 }
 567
 568 /*
 569  * Replace the original sexpr with the macro expansion, then
 570  * execute that
 571  */
 572 static int
 573 ao_lisp_eval_macro(void)
 574 {
 575         DBGI("macro: "); DBG_POLY(ao_lisp_v); DBG(" sexprs "); DBG_POLY(ao_lisp_stack->sexprs); DBG("\n");
 576
 577         if (ao_lisp_v == AO_LISP_NIL)
 578                 ao_lisp_abort();
 579         if (ao_lisp_poly_type(ao_lisp_v) == AO_LISP_CONS) {
 580                 *ao_lisp_poly_cons(ao_lisp_stack->sexprs) = *ao_lisp_poly_cons(ao_lisp_v);
 581                 ao_lisp_v = ao_lisp_stack->sexprs;
 582                 DBGI("sexprs rewritten to: "); DBG_POLY(ao_lisp_v); DBG("\n");
 583         }
 584         ao_lisp_stack->sexprs = AO_LISP_NIL;
 585         ao_lisp_stack->state = eval_sexpr;
 586         return 1;
 587 }
 588
 589 static int (*const evals[])(void) = {
 590         [eval_sexpr] = ao_lisp_eval_sexpr,
 591         [eval_val] = ao_lisp_eval_val,
 592         [eval_formal] = ao_lisp_eval_formal,
 593         [eval_exec] = ao_lisp_eval_exec,
 594         [eval_cond] = ao_lisp_eval_cond,
 595         [eval_cond_test] = ao_lisp_eval_cond_test,
 596         [eval_progn] = ao_lisp_eval_progn,
 597         [eval_while] = ao_lisp_eval_while,
 598         [eval_while_test] = ao_lisp_eval_while_test,
 599         [eval_macro] = ao_lisp_eval_macro,
 600 };
 601
 602 /*
 603  * Called at restore time to reset all execution state
 604  */
 605
 606 void
 607 ao_lisp_eval_clear_globals(void)
 608 {
 609         ao_lisp_stack = NULL;
 610         ao_lisp_frame_current = NULL;
 611         ao_lisp_v = AO_LISP_NIL;
 612 }
 613
 614 int
 615 ao_lisp_eval_restart(void)
 616 {
 617         return ao_lisp_stack_push();
 618 }
 619
 620 ao_poly
 621 ao_lisp_eval(ao_poly _v)
 622 {
 623         ao_lisp_v = _v;
 624
 625         if (!ao_lisp_stack_push())
 626                 return AO_LISP_NIL;
 627
 628         while (ao_lisp_stack) {
 629                 if (!(*evals[ao_lisp_stack->state])() || ao_lisp_exception) {
 630                         ao_lisp_stack_clear();
 631                         return AO_LISP_NIL;
 632                 }
 633         }
 634         DBG_DO(if (ao_lisp_frame_current) {DBGI("frame left as "); DBG_POLY(ao_lisp_frame_poly(ao_lisp_frame_current)); DBG("\n");});
 635         ao_lisp_frame_current = NULL;
 636         return ao_lisp_v;
 637 }