git.gag.com Git - fw/altos/blob - src/lisp/ao_lisp_cons.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 #include "ao_lisp.h"
  16
  17 #define OFFSET(a)       ((int) ((uint8_t *) (a) - ao_lisp_const))
  18
  19 #if 0
  20 static int cons_depth;
  21 #define DBG(...)        do { int d; for (d = 0; d < cons_depth; d++) printf ("  "); printf(__VA_ARGS__); } while(0)
  22 #define DBG_IN()        (cons_depth++)
  23 #define DBG_OUT()       (cons_depth--)
  24 #define DBG_PR(c)       ao_lisp_cons_print(ao_lisp_cons_poly(c))
  25 #define DBG_PRP(p)      ao_lisp_poly_print(p)
  26 #else
  27 #define DBG(...)
  28 #define DBG_IN()
  29 #define DBG_OUT()
  30 #define DBG_PR(c)
  31 #define DBG_PRP(p)
  32 #endif
  33
  34 static void cons_mark(void *addr)
  35 {
  36         struct ao_lisp_cons     *cons = addr;
  37
  38         for (;;) {
  39                 ao_lisp_poly_mark(cons->car);
  40                 cons = ao_lisp_poly_cons(cons->cdr);
  41                 if (!cons)
  42                         break;
  43                 if (ao_lisp_mark_memory(cons, sizeof (struct ao_lisp_cons)))
  44                         break;
  45         }
  46 }
  47
  48 static int cons_size(void *addr)
  49 {
  50         (void) addr;
  51         return sizeof (struct ao_lisp_cons);
  52 }
  53
  54 static void cons_move(void *addr)
  55 {
  56         struct ao_lisp_cons     *cons = addr;
  57
  58         DBG_IN();
  59         DBG("move cons start %d\n", OFFSET(cons));
  60         for (;;) {
  61                 struct ao_lisp_cons     *cdr;
  62                 ao_poly                 car;
  63
  64                 car = ao_lisp_poly_move(cons->car);
  65                 DBG(" moved car %d -> %d\n", OFFSET(ao_lisp_ref(cons->car)), OFFSET(ao_lisp_ref(car)));
  66                 cons->car = car;
  67                 cdr = ao_lisp_poly_cons(cons->cdr);
  68                 cdr = ao_lisp_move_memory(cdr, sizeof (struct ao_lisp_cons));
  69                 if (!cdr)
  70                         break;
  71                 DBG(" moved cdr %d -> %d\n", OFFSET(ao_lisp_poly_cons(cons->cdr)), OFFSET(cdr));
  72                 cons->cdr = ao_lisp_cons_poly(cdr);
  73                 cons = cdr;
  74         }
  75         DBG("move cons end\n");
  76         DBG_OUT();
  77 }
  78
  79 const struct ao_lisp_type ao_lisp_cons_type = {
  80         .mark = cons_mark,
  81         .size = cons_size,
  82         .move = cons_move,
  83 };
  84
  85 struct ao_lisp_cons *
  86 ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr)
  87 {
  88         struct ao_lisp_cons     *cons = ao_lisp_alloc(sizeof (struct ao_lisp_cons));
  89         if (!cons)
  90                 return NULL;
  91         cons->car = car;
  92         cons->cdr = ao_lisp_cons_poly(cdr);
  93         return cons;
  94 }
  95
  96 void
  97 ao_lisp_cons_print(ao_poly c)
  98 {
  99         struct ao_lisp_cons *cons = ao_lisp_poly_cons(c);
 100         int     first = 1;
 101         printf("(");
 102         while (cons) {
 103                 if (!first)
 104                         printf(" ");
 105                 ao_lisp_poly_print(cons->car);
 106                 cons = ao_lisp_poly_cons(cons->cdr);
 107                 first = 0;
 108         }
 109         printf(")");
 110 }