git.gag.com Git - fw/altos/blob - src/lisp/ao_lisp.h

   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 #ifndef _AO_LISP_H_
  16 #define _AO_LISP_H_
  17
  18 #if !defined(AO_LISP_TEST) && !defined(AO_LISP_MAKE_CONST)
  19 #include <ao.h>
  20 #define AO_LISP_ALTOS   1
  21 #endif
  22
  23 #include <stdint.h>
  24 #include <string.h>
  25 #include <stdio.h>
  26
  27 #ifdef AO_LISP_MAKE_CONST
  28 #define AO_LISP_POOL_CONST      16384
  29 extern uint8_t ao_lisp_const[AO_LISP_POOL_CONST];
  30 #else
  31 #include "ao_lisp_const.h"
  32 #endif
  33
  34 /* Primitive types */
  35 #define AO_LISP_CONS            0
  36 #define AO_LISP_INT             1
  37 #define AO_LISP_STRING          2
  38 #define AO_LISP_OTHER           3
  39
  40 #define AO_LISP_TYPE_MASK       0x0003
  41 #define AO_LISP_TYPE_SHIFT      2
  42 #define AO_LISP_REF_MASK        0x7ffc
  43 #define AO_LISP_CONST           0x8000
  44
  45 /* These have a type value at the start of the struct */
  46 #define AO_LISP_ATOM            4
  47 #define AO_LISP_BUILTIN         5
  48 #define AO_LISP_NUM_TYPE        6
  49
  50 #define AO_LISP_NIL     0
  51
  52 #define AO_LISP_POOL    1024
  53
  54 extern uint8_t          ao_lisp_pool[AO_LISP_POOL];
  55 extern uint16_t         ao_lisp_top;
  56
  57 #define AO_LISP_OOM             0x01
  58 #define AO_LISP_DIVIDE_BY_ZERO  0x02
  59 #define AO_LISP_INVALID         0x04
  60
  61 extern uint8_t          ao_lisp_exception;
  62
  63 typedef uint16_t        ao_poly;
  64
  65 static inline void *
  66 ao_lisp_ref(ao_poly poly) {
  67         if (poly == AO_LISP_NIL)
  68                 return NULL;
  69         if (poly & AO_LISP_CONST)
  70                 return (void *) ((ao_lisp_const - 4) + (poly & AO_LISP_REF_MASK));
  71         else
  72                 return (void *) ((ao_lisp_pool - 4) + (poly & AO_LISP_REF_MASK));
  73 }
  74
  75 static inline ao_poly
  76 ao_lisp_poly(const void *addr, ao_poly type) {
  77         const uint8_t   *a = addr;
  78         if (addr == NULL)
  79                 return AO_LISP_NIL;
  80         if (ao_lisp_pool <= a && a < ao_lisp_pool + AO_LISP_POOL)
  81                 return (a - (ao_lisp_pool - 4)) | type;
  82         else if (ao_lisp_const <= a && a <= ao_lisp_const + AO_LISP_POOL_CONST)
  83                 return AO_LISP_CONST | (a - (ao_lisp_const - 4)) | type;
  84         else {
  85                 ao_lisp_exception |= AO_LISP_INVALID;
  86                 return AO_LISP_NIL;
  87         }
  88 }
  89
  90 #define AO_LISP_POLY(addr, type) (((ao_lisp_pool <= ((uint8_t *) (a)) && \
  91                                     ((uint8_t *) (a)) < ao_lisp_pool + AO_LISP_POOL) ? \
  92                                    ((uint8_t *) (a) - (ao_lisp_pool - 4)) : \
  93                                    (((uint8_t *) (a) - (ao_lisp_const - 4)) | AO_LISP_POOL_CONST)) | \
  94                                   (type))
  95
  96 struct ao_lisp_type {
  97         void    (*mark)(void *addr);
  98         int     (*size)(void *addr);
  99         void    (*move)(void *addr);
 100 };
 101
 102 struct ao_lisp_cons {
 103         ao_poly         car;
 104         ao_poly         cdr;
 105 };
 106
 107 struct ao_lisp_atom {
 108         uint8_t         type;
 109         uint8_t         pad[1];
 110         ao_poly         val;
 111         ao_poly         next;
 112         char            name[];
 113 };
 114
 115 #define AO_LISP_LAMBDA  0
 116 #define AO_LISP_NLAMBDA 1
 117 #define AO_LISP_MACRO   2
 118 #define AO_LISP_LEXPR   3
 119
 120 struct ao_lisp_builtin {
 121         uint8_t         type;
 122         uint8_t         args;
 123         uint16_t        func;
 124 };
 125
 126 enum ao_lisp_builtin_id {
 127         builtin_car,
 128         builtin_cdr,
 129         builtin_cons,
 130         builtin_quote,
 131         builtin_print,
 132         builtin_plus,
 133         builtin_minus,
 134         builtin_times,
 135         builtin_divide,
 136         builtin_mod,
 137         builtin_last
 138 };
 139
 140 typedef ao_poly (*ao_lisp_func_t)(struct ao_lisp_cons *cons);
 141
 142 extern ao_lisp_func_t   ao_lisp_builtins[];
 143
 144 static inline ao_lisp_func_t
 145 ao_lisp_func(struct ao_lisp_builtin *b)
 146 {
 147         return ao_lisp_builtins[b->func];
 148 }
 149
 150 static inline void *
 151 ao_lisp_poly_other(ao_poly poly) {
 152         return ao_lisp_ref(poly);
 153 }
 154
 155 static inline ao_poly
 156 ao_lisp_other_poly(const void *other)
 157 {
 158         return ao_lisp_poly(other, AO_LISP_OTHER);
 159 }
 160
 161 static inline int
 162 ao_lisp_mem_round(int size)
 163 {
 164         return (size + 3) & ~3;
 165 }
 166
 167 #define AO_LISP_OTHER_POLY(other) ((ao_poly)(other) + AO_LISP_OTHER)
 168
 169 static inline int ao_lisp_poly_type(ao_poly poly) {
 170         int     type = poly & 3;
 171         if (type == AO_LISP_OTHER)
 172                 return *((uint8_t *) ao_lisp_poly_other(poly));
 173         return type;
 174 }
 175
 176 static inline struct ao_lisp_cons *
 177 ao_lisp_poly_cons(ao_poly poly)
 178 {
 179         return ao_lisp_ref(poly);
 180 }
 181
 182 static inline ao_poly
 183 ao_lisp_cons_poly(struct ao_lisp_cons *cons)
 184 {
 185         return ao_lisp_poly(cons, AO_LISP_CONS);
 186 }
 187
 188 static inline int
 189 ao_lisp_poly_int(ao_poly poly)
 190 {
 191         return (int) poly >> AO_LISP_TYPE_SHIFT;
 192 }
 193
 194 static inline ao_poly
 195 ao_lisp_int_poly(int i)
 196 {
 197         return ((ao_poly) i << 2) + AO_LISP_INT;
 198 }
 199
 200 static inline char *
 201 ao_lisp_poly_string(ao_poly poly)
 202 {
 203         return ao_lisp_ref(poly);
 204 }
 205
 206 static inline ao_poly
 207 ao_lisp_string_poly(char *s)
 208 {
 209         return ao_lisp_poly(s, AO_LISP_STRING);
 210 }
 211
 212 static inline struct ao_lisp_atom *
 213 ao_lisp_poly_atom(ao_poly poly)
 214 {
 215         return ao_lisp_ref(poly);
 216 }
 217
 218 static inline ao_poly
 219 ao_lisp_atom_poly(struct ao_lisp_atom *a)
 220 {
 221         return ao_lisp_poly(a, AO_LISP_OTHER);
 222 }
 223
 224 static inline struct ao_lisp_builtin *
 225 ao_lisp_poly_builtin(ao_poly poly)
 226 {
 227         return ao_lisp_ref(poly);
 228 }
 229
 230 static inline ao_poly
 231 ao_lisp_builtin_poly(struct ao_lisp_builtin *b)
 232 {
 233         return ao_lisp_poly(b, AO_LISP_OTHER);
 234 }
 235
 236 /* memory functions */
 237 void
 238 ao_lisp_mark(const struct ao_lisp_type *type, void *addr);
 239
 240 /* returns 1 if the object was already marked */
 241 int
 242 ao_lisp_mark_memory(void *addr, int size);
 243
 244 void *
 245 ao_lisp_move(const struct ao_lisp_type *type, void *addr);
 246
 247 /* returns NULL if the object was already moved */
 248 void *
 249 ao_lisp_move_memory(void *addr, int size);
 250
 251 void *
 252 ao_lisp_alloc(int size);
 253
 254 int
 255 ao_lisp_root_add(const struct ao_lisp_type *type, void *addr);
 256
 257 void
 258 ao_lisp_root_clear(void *addr);
 259
 260 /* cons */
 261 extern const struct ao_lisp_type ao_lisp_cons_type;
 262
 263 struct ao_lisp_cons *
 264 ao_lisp_cons_cons(ao_poly car, struct ao_lisp_cons *cdr);
 265
 266 void
 267 ao_lisp_cons_print(ao_poly);
 268
 269 /* string */
 270 extern const struct ao_lisp_type ao_lisp_string_type;
 271
 272 char *
 273 ao_lisp_string_new(int len);
 274
 275 char *
 276 ao_lisp_string_copy(char *a);
 277
 278 char *
 279 ao_lisp_string_cat(char *a, char *b);
 280
 281 void
 282 ao_lisp_string_print(ao_poly s);
 283
 284 /* atom */
 285 extern const struct ao_lisp_type ao_lisp_atom_type;
 286
 287 extern struct ao_lisp_atom *ao_lisp_atoms;
 288
 289 void
 290 ao_lisp_atom_init(void);
 291
 292 void
 293 ao_lisp_atom_print(ao_poly a);
 294
 295 struct ao_lisp_atom *
 296 ao_lisp_atom_intern(char *name);
 297
 298 /* int */
 299 void
 300 ao_lisp_int_print(ao_poly i);
 301
 302 /* prim */
 303 ao_poly
 304 ao_lisp_poly_print(ao_poly p);
 305
 306 void
 307 ao_lisp_poly_mark(ao_poly p);
 308
 309 ao_poly
 310 ao_lisp_poly_move(ao_poly p);
 311
 312 /* eval */
 313 ao_poly
 314 ao_lisp_eval(ao_poly p);
 315
 316 /* builtin */
 317 void
 318 ao_lisp_builtin_print(ao_poly b);
 319
 320 /* read */
 321 ao_poly
 322 ao_lisp_read(void);
 323
 324 /* rep */
 325 ao_poly
 326 ao_lisp_read_eval_print(void);
 327
 328 #endif /* _AO_LISP_H_ */