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