git.gag.com Git - fw/altos/blob - src/lisp/ao_lisp_mem.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 AO_LISP_CONST_BITS
  16
  17 #include "ao_lisp.h"
  18 #include <stdio.h>
  19
  20 #ifdef AO_LISP_MAKE_CONST
  21
  22 /*
  23  * When building the constant table, it is the
  24  * pool for allocations.
  25  */
  26
  27 #include <stdlib.h>
  28 uint8_t ao_lisp_const[AO_LISP_POOL_CONST] __attribute__((aligned(4)));
  29 #define ao_lisp_pool ao_lisp_const
  30 #undef AO_LISP_POOL
  31 #define AO_LISP_POOL AO_LISP_POOL_CONST
  32
  33 #else
  34
  35 uint8_t ao_lisp_pool[AO_LISP_POOL + AO_LISP_POOL_EXTRA] __attribute__((aligned(4)));
  36
  37 #endif
  38
  39 #if 0
  40 #define MDBG_POOL
  41 #endif
  42
  43 #if DBG_MEM
  44 int dbg_move_depth;
  45 int dbg_mem = DBG_MEM_START;
  46 int dbg_collects = 0;
  47 int dbg_validate = 0;
  48
  49 struct ao_lisp_record {
  50         struct ao_lisp_record           *next;
  51         const struct ao_lisp_type       *type;
  52         void                            *addr;
  53         int                             size;
  54 };
  55
  56 static struct ao_lisp_record    *record_head, **record_tail;
  57
  58 static void
  59 ao_lisp_record_free(struct ao_lisp_record *record)
  60 {
  61         while (record) {
  62                 struct ao_lisp_record *next = record->next;
  63                 free(record);
  64                 record = next;
  65         }
  66 }
  67
  68 static void
  69 ao_lisp_record_reset(void)
  70 {
  71         ao_lisp_record_free(record_head);
  72         record_head = NULL;
  73         record_tail = &record_head;
  74 }
  75
  76 static void
  77 ao_lisp_record(const struct ao_lisp_type        *type,
  78                void                             *addr,
  79                int                              size)
  80 {
  81         struct ao_lisp_record   *r = malloc(sizeof (struct ao_lisp_record));
  82
  83         r->next = NULL;
  84         r->type = type;
  85         r->addr = addr;
  86         r->size = size;
  87         *record_tail = r;
  88         record_tail = &r->next;
  89 }
  90
  91 static struct ao_lisp_record *
  92 ao_lisp_record_save(void)
  93 {
  94         struct ao_lisp_record *r = record_head;
  95
  96         record_head = NULL;
  97         record_tail = &record_head;
  98         return r;
  99 }
 100
 101 static void
 102 ao_lisp_record_compare(char *where,
 103                        struct ao_lisp_record *a,
 104                        struct ao_lisp_record *b)
 105 {
 106         while (a && b) {
 107                 if (a->type != b->type || a->size != b->size) {
 108                         printf("%s record difers %d %s %d -> %d %s %d\n",
 109                                where,
 110                                MDBG_OFFSET(a->addr),
 111                                a->type->name,
 112                                a->size,
 113                                MDBG_OFFSET(b->addr),
 114                                b->type->name,
 115                                b->size);
 116                         ao_lisp_abort();
 117                 }
 118                 a = a->next;
 119                 b = b->next;
 120         }
 121         if (a) {
 122                 printf("%s record differs %d %s %d -> NULL\n",
 123                        where,
 124                        MDBG_OFFSET(a->addr),
 125                        a->type->name,
 126                        a->size);
 127                 ao_lisp_abort();
 128         }
 129         if (b) {
 130                 printf("%s record differs NULL -> %d %s %d\n",
 131                        where,
 132                        MDBG_OFFSET(b->addr),
 133                        b->type->name,
 134                        b->size);
 135                 ao_lisp_abort();
 136         }
 137 }
 138
 139 #else
 140 #define ao_lisp_record_reset()
 141 #endif
 142
 143 uint8_t ao_lisp_exception;
 144
 145 struct ao_lisp_root {
 146         const struct ao_lisp_type       *type;
 147         void                            **addr;
 148 };
 149
 150 static struct ao_lisp_cons      *save_cons[2];
 151 static char                     *save_string[2];
 152 static ao_poly                  save_poly[2];
 153
 154 static const struct ao_lisp_root        ao_lisp_root[] = {
 155         {
 156                 .type = &ao_lisp_cons_type,
 157                 .addr = (void **) &save_cons[0],
 158         },
 159         {
 160                 .type = &ao_lisp_cons_type,
 161                 .addr = (void **) &save_cons[1],
 162         },
 163         {
 164                 .type = &ao_lisp_string_type,
 165                 .addr = (void **) &save_string[0]
 166         },
 167         {
 168                 .type = &ao_lisp_string_type,
 169                 .addr = (void **) &save_string[1]
 170         },
 171         {
 172                 .type = NULL,
 173                 .addr = (void **) &save_poly[0]
 174         },
 175         {
 176                 .type = NULL,
 177                 .addr = (void **) &save_poly[1]
 178         },
 179         {
 180                 .type = &ao_lisp_atom_type,
 181                 .addr = (void **) &ao_lisp_atoms
 182         },
 183         {
 184                 .type = &ao_lisp_frame_type,
 185                 .addr = (void **) &ao_lisp_frame_global,
 186         },
 187         {
 188                 .type = &ao_lisp_frame_type,
 189                 .addr = (void **) &ao_lisp_frame_current,
 190         },
 191         {
 192                 .type = &ao_lisp_stack_type,
 193                 .addr = (void **) &ao_lisp_stack,
 194         },
 195         {
 196                 .type = NULL,
 197                 .addr = (void **) &ao_lisp_v,
 198         },
 199         {
 200                 .type = &ao_lisp_cons_type,
 201                 .addr = (void **) &ao_lisp_read_cons,
 202         },
 203         {
 204                 .type = &ao_lisp_cons_type,
 205                 .addr = (void **) &ao_lisp_read_cons_tail,
 206         },
 207         {
 208                 .type = &ao_lisp_cons_type,
 209                 .addr = (void **) &ao_lisp_read_stack,
 210         },
 211 };
 212
 213 #define AO_LISP_ROOT    (sizeof (ao_lisp_root) / sizeof (ao_lisp_root[0]))
 214
 215 #define AO_LISP_BUSY_SIZE       ((AO_LISP_POOL + 31) / 32)
 216
 217 static uint8_t  ao_lisp_busy[AO_LISP_BUSY_SIZE];
 218 static uint8_t  ao_lisp_cons_note[AO_LISP_BUSY_SIZE];
 219 static uint8_t  ao_lisp_cons_last[AO_LISP_BUSY_SIZE];
 220 static uint8_t  ao_lisp_cons_noted;
 221
 222 uint16_t        ao_lisp_top;
 223
 224 struct ao_lisp_chunk {
 225         uint16_t                old_addr;
 226         union {
 227                 uint16_t        size;
 228                 uint16_t        new_addr;
 229         };
 230 };
 231
 232 #define AO_LISP_NCHUNK  32
 233
 234 static struct ao_lisp_chunk ao_lisp_chunk[AO_LISP_NCHUNK];
 235
 236 /* Offset of an address within the pool. */
 237 static inline uint16_t pool_offset(void *addr) {
 238         if (!AO_LISP_IS_POOL(addr))
 239                 ao_lisp_abort();
 240         return ((uint8_t *) addr) - ao_lisp_pool;
 241 }
 242
 243 /*
 244  * Convert back and forth between 'poly's used
 245  * as short addresses in the pool and addresses.
 246  * These are used in the chunk code.
 247  */
 248 static inline ao_poly pool_poly(void *addr) {
 249         if (!AO_LISP_IS_POOL(addr))
 250                 ao_lisp_abort();
 251         return ((uint8_t *) addr) - AO_LISP_POOL_BASE;
 252 }
 253
 254 static inline void *pool_ref(ao_poly p) {
 255         return AO_LISP_POOL_BASE + p;
 256 }
 257
 258 static inline void mark(uint8_t *tag, int offset) {
 259         int     byte = offset >> 5;
 260         int     bit = (offset >> 2) & 7;
 261         tag[byte] |= (1 << bit);
 262 }
 263
 264 static inline void clear(uint8_t *tag, int offset) {
 265         int     byte = offset >> 5;
 266         int     bit = (offset >> 2) & 7;
 267         tag[byte] &= ~(1 << bit);
 268 }
 269
 270 static inline int busy(uint8_t *tag, int offset) {
 271         int     byte = offset >> 5;
 272         int     bit = (offset >> 2) & 7;
 273         return (tag[byte] >> bit) & 1;
 274 }
 275
 276 static inline int min(int a, int b) { return a < b ? a : b; }
 277 static inline int max(int a, int b) { return a > b ? a : b; }
 278
 279 static inline int limit(int offset) {
 280         return min(AO_LISP_POOL, max(offset, 0));
 281 }
 282
 283 static int total_marked;
 284
 285 /*
 286  * Mark a range of addresses
 287  */
 288 static int
 289 mark_object(uint8_t *tag, void *addr, int size) {
 290         int     base;
 291         int     bound;
 292
 293         MDBG_DO(if (!AO_LISP_IS_POOL((uint8_t *) addr + size - 1))
 294                         ao_lisp_abort());
 295
 296         base = pool_offset(addr);
 297         bound = base + size;
 298
 299         MDBG_DO(if (bound > ao_lisp_top) ao_lisp_abort());
 300
 301         if (busy(tag, base))
 302                 return 1;
 303         if (tag == ao_lisp_busy)
 304                 total_marked += size;
 305         while (base < bound) {
 306                 mark(tag, base);
 307                 base += 4;
 308         }
 309         return 0;
 310 }
 311
 312 MDBG_DO(
 313 static int
 314 clear_object(uint8_t *tag, void *addr, int size) {
 315         int     base;
 316         int     bound;
 317
 318         MDBG_DO(if (!AO_LISP_IS_POOL((uint8_t *) addr + size - 1))
 319                         ao_lisp_abort());
 320
 321         base = (uint8_t *) addr - ao_lisp_pool;
 322         bound = base + size;
 323
 324         base = limit(base);
 325         bound = limit(bound);
 326         if (!busy(tag, base))
 327                 return 1;
 328         total_marked -= size;
 329         while (base < bound) {
 330                 clear(tag, base);
 331                 base += 4;
 332         }
 333         return 0;
 334 })
 335
 336 static void
 337 note_cons(void *addr)
 338 {
 339         if (AO_LISP_IS_POOL(addr)) {
 340                 int     offset = (uint8_t *) addr - ao_lisp_pool;
 341                 MDBG_MOVE("note cons %d\n", MDBG_OFFSET(addr));
 342                 ao_lisp_cons_noted = 1;
 343                 mark(ao_lisp_cons_note, offset);
 344         }
 345 }
 346
 347 static uint16_t chunk_low;
 348 static uint16_t chunk_first, chunk_last;
 349
 350 static void
 351 note_chunk(uint16_t addr, uint16_t size)
 352 {
 353         int i;
 354
 355         if (addr < chunk_low)
 356                 return;
 357
 358         for (i = 0; i < AO_LISP_NCHUNK; i++) {
 359                 if (ao_lisp_chunk[i].size && ao_lisp_chunk[i].old_addr == addr) {
 360                         if (ao_lisp_chunk[i].size != size)
 361                                 ao_lisp_abort();
 362                         return;
 363                 }
 364                 if (ao_lisp_chunk[i].old_addr > addr) {
 365                         memmove(&ao_lisp_chunk[i+1],
 366                                 &ao_lisp_chunk[i],
 367                                 (AO_LISP_NCHUNK - (i+1)) * sizeof (struct ao_lisp_chunk));
 368                         ao_lisp_chunk[i].size = 0;
 369                 }
 370                 if (ao_lisp_chunk[i].size == 0) {
 371                         ao_lisp_chunk[i].old_addr = addr;
 372                         ao_lisp_chunk[i].size = size;
 373                         return;
 374                 }
 375         }
 376 }
 377
 378 /*
 379  * Walk all referenced objects calling functions on each one
 380  */
 381
 382 static void
 383 walk(int (*visit_addr)(const struct ao_lisp_type *type, void **addr),
 384      int (*visit_poly)(ao_poly *p, uint8_t do_note_cons))
 385 {
 386         int i;
 387
 388         total_marked = 0;
 389         ao_lisp_record_reset();
 390         memset(ao_lisp_busy, '\0', sizeof (ao_lisp_busy));
 391         memset(ao_lisp_cons_note, '\0', sizeof (ao_lisp_cons_note));
 392         ao_lisp_cons_noted = 0;
 393         for (i = 0; i < AO_LISP_ROOT; i++) {
 394                 if (ao_lisp_root[i].type) {
 395                         void **a = ao_lisp_root[i].addr, *v;
 396                         if (a && (v = *a)) {
 397                                 MDBG_MOVE("root ptr %d\n", MDBG_OFFSET(v));
 398                                 visit_addr(ao_lisp_root[i].type, a);
 399                         }
 400                 } else {
 401                         ao_poly *a = (ao_poly *) ao_lisp_root[i].addr, p;
 402                         if (a && (p = *a)) {
 403                                 MDBG_MOVE("root poly %d\n", MDBG_OFFSET(ao_lisp_ref(p)));
 404                                 visit_poly(a, 0);
 405                         }
 406                 }
 407         }
 408         while (ao_lisp_cons_noted) {
 409                 memcpy(ao_lisp_cons_last, ao_lisp_cons_note, sizeof (ao_lisp_cons_note));
 410                 memset(ao_lisp_cons_note, '\0', sizeof (ao_lisp_cons_note));
 411                 ao_lisp_cons_noted = 0;
 412                 for (i = 0; i < AO_LISP_POOL; i += 4) {
 413                         if (busy(ao_lisp_cons_last, i)) {
 414                                 void *v = ao_lisp_pool + i;
 415                                 MDBG_MOVE("root cons %d\n", MDBG_OFFSET(v));
 416                                 visit_addr(&ao_lisp_cons_type, &v);
 417                         }
 418                 }
 419         }
 420 }
 421
 422 #if MDBG_DUMP
 423 static void
 424 dump_busy(void)
 425 {
 426         int     i;
 427         MDBG_MOVE("busy:");
 428         for (i = 0; i < ao_lisp_top; i += 4) {
 429                 if ((i & 0xff) == 0) {
 430                         MDBG_MORE("\n");
 431                         MDBG_MOVE("%s", "");
 432                 }
 433                 else if ((i & 0x1f) == 0)
 434                         MDBG_MORE(" ");
 435                 if (busy(ao_lisp_busy, i))
 436                         MDBG_MORE("*");
 437                 else
 438                         MDBG_MORE("-");
 439         }
 440         MDBG_MORE ("\n");
 441 }
 442 #define DUMP_BUSY()     dump_busy()
 443 #else
 444 #define DUMP_BUSY()
 445 #endif
 446
 447 static const struct ao_lisp_type const *ao_lisp_types[AO_LISP_NUM_TYPE] = {
 448         [AO_LISP_CONS] = &ao_lisp_cons_type,
 449         [AO_LISP_INT] = NULL,
 450         [AO_LISP_STRING] = &ao_lisp_string_type,
 451         [AO_LISP_OTHER] = (void *) 0x1,
 452         [AO_LISP_ATOM] = &ao_lisp_atom_type,
 453         [AO_LISP_BUILTIN] = &ao_lisp_builtin_type,
 454         [AO_LISP_FRAME] = &ao_lisp_frame_type,
 455         [AO_LISP_LAMBDA] = &ao_lisp_lambda_type,
 456 };
 457
 458 static int
 459 ao_lisp_mark_ref(const struct ao_lisp_type *type, void **ref)
 460 {
 461         return ao_lisp_mark(type, *ref);
 462 }
 463
 464 static int
 465 ao_lisp_poly_mark_ref(ao_poly *p, uint8_t do_note_cons)
 466 {
 467         return ao_lisp_poly_mark(*p, do_note_cons);
 468 }
 469
 470 void
 471 ao_lisp_collect(void)
 472 {
 473         int     i;
 474         int     top;
 475 #if DBG_MEM
 476         int     loops = 0;
 477         int     marked;
 478         int     moved;
 479         struct ao_lisp_record   *mark_record = NULL, *move_record = NULL;
 480
 481         ++dbg_collects;
 482         MDBG_MOVE("collect %d\n", dbg_collects);
 483         marked = moved = 0;
 484 #endif
 485         chunk_low = 0;
 486         top = 0;
 487         for (;;) {
 488                 MDBG_DO(loops++);
 489                 MDBG_MOVE("move chunks from %d to %d\n", chunk_low, top);
 490                 /* Find the sizes of the first chunk of objects to move */
 491                 memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
 492                 walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref);
 493 #if DBG_MEM
 494                 marked = total_marked;
 495
 496                 ao_lisp_record_free(mark_record);
 497                 mark_record = ao_lisp_record_save();
 498                 if (mark_record && move_record)
 499                         ao_lisp_record_compare("mark", move_record, mark_record);
 500
 501                 if (moved && moved != marked)
 502                         ao_lisp_abort();
 503 #endif
 504
 505                 DUMP_BUSY();
 506
 507                 /* Find the first moving object */
 508                 for (i = 0; i < AO_LISP_NCHUNK; i++) {
 509                         uint16_t        size = ao_lisp_chunk[i].size;
 510
 511                         if (!size)
 512                                 break;
 513
 514                         if (ao_lisp_chunk[i].old_addr > top)
 515                                 break;
 516                         if (ao_lisp_chunk[i].old_addr != top)
 517                                 ao_lisp_abort();
 518
 519                         top += size;
 520                         MDBG_MOVE("chunk %d %d not moving\n",
 521                                   ao_lisp_chunk[i].old_addr,
 522                                   ao_lisp_chunk[i].size);
 523                         chunk_low = ao_lisp_chunk[i].old_addr + size;
 524                 }
 525
 526                 chunk_first = i;
 527                 /* Copy all of the objects */
 528                 for (; i < AO_LISP_NCHUNK; i++) {
 529                         uint16_t        size = ao_lisp_chunk[i].size;
 530
 531                         if (!size)
 532                                 break;
 533
 534                         MDBG_MOVE("chunk %d %d -> %d\n",
 535                                   ao_lisp_chunk[i].old_addr,
 536                                   size,
 537                                   top);
 538                         ao_lisp_chunk[i].new_addr = top;
 539                         memmove(&ao_lisp_pool[top],
 540                                 &ao_lisp_pool[ao_lisp_chunk[i].old_addr],
 541                                 size);
 542                         MDBG_DO(clear_object(ao_lisp_busy, &ao_lisp_pool[ao_lisp_chunk[i].old_addr], size));
 543                         MDBG_DO(mark_object(ao_lisp_busy, &ao_lisp_pool[top], size));
 544                         top += size;
 545                         chunk_low = ao_lisp_chunk[i].old_addr + size;
 546                 }
 547
 548                 MDBG_MOVE("after moving objects, busy is now:\n");
 549                 DUMP_BUSY();
 550                 chunk_last = i;
 551
 552                 if (chunk_first < chunk_last) {
 553                         /* Relocate all references to the objects */
 554                         walk(ao_lisp_move, ao_lisp_poly_move);
 555
 556 #if DBG_MEM
 557                         ao_lisp_record_free(move_record);
 558                         move_record = ao_lisp_record_save();
 559                         if (mark_record && move_record)
 560                                 ao_lisp_record_compare("move", mark_record, move_record);
 561
 562                         moved = total_marked;
 563                         if (moved != marked)
 564                                 ao_lisp_abort();
 565 #endif
 566                 }
 567
 568                 if (chunk_last != AO_LISP_NCHUNK)
 569                         break;
 570         }
 571         ao_lisp_top = top;
 572
 573         MDBG_DO(memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
 574                 walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref));
 575
 576 //      printf ("collect. top %d loops %d\n", top, loops);
 577 }
 578
 579 /*
 580  * Mark interfaces for objects
 581  *
 582  * Note a reference to memory and
 583  * collect information about a few object sizes
 584  * at a time
 585  */
 586
 587 int
 588 ao_lisp_mark_memory(const struct ao_lisp_type *type, void *addr)
 589 {
 590         int size;
 591         if (!AO_LISP_IS_POOL(addr))
 592                 return 1;
 593
 594         size = ao_lisp_size(type, addr);
 595         MDBG_MOVE("mark memory %d\n", MDBG_OFFSET(addr));
 596         if (!mark_object(ao_lisp_busy, addr, size)) {
 597                 note_chunk(pool_offset(addr), size);
 598                 MDBG_DO(ao_lisp_record(type, addr, size));
 599                 return 0;
 600         }
 601         MDBG_MOVE("already marked\n");
 602         return 1;
 603 }
 604
 605 int
 606 ao_lisp_mark(const struct ao_lisp_type *type, void *addr)
 607 {
 608         int ret;
 609         MDBG_MOVE("mark %d\n", MDBG_OFFSET(addr));
 610         MDBG_MOVE_IN();
 611         ret = ao_lisp_mark_memory(type, addr);
 612         if (!ret) {
 613                 MDBG_MOVE("mark recurse\n");
 614                 type->mark(addr);
 615         }
 616         MDBG_MOVE_OUT();
 617         return ret;
 618 }
 619
 620 int
 621 ao_lisp_poly_mark(ao_poly p, uint8_t do_note_cons)
 622 {
 623         uint8_t type;
 624         void    *addr;
 625
 626         if (!p)
 627                 return 1;
 628
 629         type = ao_lisp_poly_base_type(p);
 630         addr = ao_lisp_ref(p);
 631
 632         if (!AO_LISP_IS_POOL(addr))
 633                 return 1;
 634
 635         if (type == AO_LISP_CONS && do_note_cons) {
 636                 note_cons(ao_lisp_ref(p));
 637                 return 1;
 638         } else {
 639                 const struct ao_lisp_type       *lisp_type;
 640
 641                 if (type == AO_LISP_OTHER) {
 642                         type = ao_lisp_other_type(ao_lisp_poly_other(p));
 643                         if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type)
 644                                 ao_lisp_abort();
 645                 }
 646
 647                 lisp_type = ao_lisp_types[ao_lisp_poly_type(p)];
 648                 if (!lisp_type)
 649                         return 1;
 650                 return ao_lisp_mark(lisp_type, ao_lisp_ref(p));
 651         }
 652 }
 653
 654 static void *
 655 move_map(void *addr)
 656 {
 657         uint16_t        offset = pool_offset(addr);
 658         int             i;
 659
 660         for (i = chunk_first; i < chunk_last; i++) {
 661                 if (ao_lisp_chunk[i].old_addr == offset) {
 662                         MDBG_MOVE("move %d -> %d\n",
 663                                   ao_lisp_chunk[i].old_addr,
 664                                   ao_lisp_chunk[i].new_addr);
 665                         return ao_lisp_pool + ao_lisp_chunk[i].new_addr;
 666                 }
 667         }
 668         return addr;
 669 }
 670
 671 int
 672 ao_lisp_move_memory(const struct ao_lisp_type *type, void **ref)
 673 {
 674         void            *addr = *ref;
 675         int             size;
 676
 677         if (!AO_LISP_IS_POOL(addr))
 678                 return 1;
 679
 680         MDBG_MOVE("move memory %d\n", MDBG_OFFSET(addr));
 681         addr = move_map(addr);
 682         size = ao_lisp_size(type, addr);
 683         if (addr != *ref) {
 684                 MDBG_MOVE("update ref %d %d -> %d\n",
 685                           AO_LISP_IS_POOL(ref) ? MDBG_OFFSET(ref) : -1,
 686                           MDBG_OFFSET(*ref), MDBG_OFFSET(addr));
 687                 *ref = addr;
 688         }
 689         if (!mark_object(ao_lisp_busy, addr, size)) {
 690                 MDBG_DO(ao_lisp_record(type, addr, size));
 691                 return 0;
 692         }
 693         MDBG_MOVE("already moved\n");
 694         return 1;
 695 }
 696
 697 int
 698 ao_lisp_move(const struct ao_lisp_type *type, void **ref)
 699 {
 700         int ret;
 701         MDBG_MOVE("move object %d\n", MDBG_OFFSET(*ref));
 702         MDBG_MOVE_IN();
 703         ret = ao_lisp_move_memory(type, ref);
 704         if (!ret) {
 705                 MDBG_MOVE("move recurse\n");
 706                 type->move(*ref);
 707         }
 708         MDBG_MOVE_OUT();
 709         return ret;
 710 }
 711
 712 int
 713 ao_lisp_poly_move(ao_poly *ref, uint8_t do_note_cons)
 714 {
 715         uint8_t                         type;
 716         ao_poly                         p = *ref;
 717         int                             ret;
 718         void                            *addr;
 719
 720         if (!p)
 721                 return 1;
 722
 723         type = ao_lisp_poly_base_type(p);
 724         addr = ao_lisp_ref(p);
 725
 726         if (!AO_LISP_IS_POOL(addr))
 727                 return 1;
 728
 729         if (type == AO_LISP_CONS && do_note_cons) {
 730 //              addr = move_map(addr);
 731                 MDBG_DO(if (addr != move_map(addr)) MDBG_MOVE("noting cons at old addr %d instead of new addr %d\n", MDBG_OFFSET(addr), MDBG_OFFSET(move_map(addr))););
 732
 733                 note_cons(addr);
 734                 addr = move_map(addr);
 735                 ret = 1;
 736         } else {
 737                 const struct ao_lisp_type       *lisp_type;
 738
 739                 if (type == AO_LISP_OTHER) {
 740                         type = ao_lisp_other_type(move_map(ao_lisp_poly_other(p)));
 741                         if (type <= AO_LISP_OTHER || AO_LISP_NUM_TYPE <= type)
 742                                 ao_lisp_abort();
 743                 }
 744
 745                 lisp_type = ao_lisp_types[type];
 746                 if (!lisp_type)
 747                         return 1;
 748                 ret = ao_lisp_move(lisp_type, &addr);
 749         }
 750
 751         /* Re-write the poly value */
 752         if (addr != ao_lisp_ref(p)) {
 753                 ao_poly np = ao_lisp_poly(addr, p & AO_LISP_TYPE_MASK);
 754                 MDBG_MOVE("poly %d moved %d -> %d\n",
 755                           type, MDBG_OFFSET(ao_lisp_ref(p)), MDBG_OFFSET(ao_lisp_ref(np)));
 756                 *ref = np;
 757         }
 758         return ret;
 759 }
 760
 761 #ifdef MDBG_POOL
 762 static int AO_LISP_POOL_CUR = AO_LISP_POOL / 8;
 763
 764 static void
 765 ao_lisp_poison(void)
 766 {
 767         int     i;
 768
 769         printf("poison\n");
 770         ao_lisp_mark_busy();
 771         for (i = 0; i < AO_LISP_POOL_CUR; i += 4) {
 772                 uint32_t        *a = (uint32_t *) &ao_lisp_pool[i];
 773                 if (!busy_object(ao_lisp_busy, a))
 774                         *a = 0xBEEFBEEF;
 775         }
 776         for (i = 0; i < AO_LISP_POOL_CUR; i += 2) {
 777                 ao_poly         *a = (uint16_t *) &ao_lisp_pool[i];
 778                 ao_poly         p = *a;
 779
 780                 if (!ao_lisp_is_const(p)) {
 781                         void    *r = ao_lisp_ref(p);
 782
 783                         if (ao_lisp_pool <= (uint8_t *) r &&
 784                             (uint8_t *) r <= ao_lisp_pool + AO_LISP_POOL_CUR)
 785                         {
 786                                 if (!busy_object(ao_lisp_busy, r)) {
 787                                         printf("missing reference from %d to %d\n",
 788                                                (int) ((uint8_t *) a - ao_lisp_pool),
 789                                                (int) ((uint8_t *) r - ao_lisp_pool));
 790                                 }
 791                         }
 792                 }
 793         }
 794 }
 795
 796 #else
 797 #define AO_LISP_POOL_CUR AO_LISP_POOL
 798 #endif
 799
 800 #if DBG_MEM
 801 void
 802 ao_lisp_validate(void)
 803 {
 804         chunk_low = 0;
 805         memset(ao_lisp_chunk, '\0', sizeof (ao_lisp_chunk));
 806         walk(ao_lisp_mark_ref, ao_lisp_poly_mark_ref);
 807 }
 808
 809 int dbg_allocs;
 810
 811 #endif
 812
 813
 814 void *
 815 ao_lisp_alloc(int size)
 816 {
 817         void    *addr;
 818
 819         MDBG_DO(++dbg_allocs);
 820         MDBG_DO(if (dbg_validate) ao_lisp_validate());
 821         size = ao_lisp_size_round(size);
 822         if (ao_lisp_top + size > AO_LISP_POOL_CUR) {
 823 #ifdef MDBG_POOL
 824                 if (AO_LISP_POOL_CUR < AO_LISP_POOL) {
 825                         AO_LISP_POOL_CUR += AO_LISP_POOL / 8;
 826                         ao_lisp_poison();
 827                 } else
 828 #endif
 829                 ao_lisp_collect();
 830 #ifdef MDBG_POOL
 831                 {
 832                         int     i;
 833
 834                         for (i = ao_lisp_top; i < AO_LISP_POOL; i += 4) {
 835                                 uint32_t        *p = (uint32_t *) &ao_lisp_pool[i];
 836                                 *p = 0xbeefbeef;
 837                         }
 838                 }
 839 #endif
 840
 841                 if (ao_lisp_top + size > AO_LISP_POOL) {
 842                         ao_lisp_error(AO_LISP_OOM, "out of memory");
 843                         return NULL;
 844                 }
 845         }
 846         addr = ao_lisp_pool + ao_lisp_top;
 847         ao_lisp_top += size;
 848         return addr;
 849 }
 850
 851 void
 852 ao_lisp_cons_stash(int id, struct ao_lisp_cons *cons)
 853 {
 854         if (save_cons[id] != NULL)
 855                 ao_lisp_abort();
 856         save_cons[id] = cons;
 857 }
 858
 859 struct ao_lisp_cons *
 860 ao_lisp_cons_fetch(int id)
 861 {
 862         struct ao_lisp_cons *cons = save_cons[id];
 863         save_cons[id] = NULL;
 864         return cons;
 865 }
 866
 867 void
 868 ao_lisp_string_stash(int id, char *string)
 869 {
 870         if (save_cons[id] != NULL)
 871                 ao_lisp_abort();
 872         save_string[id] = string;
 873 }
 874
 875 char *
 876 ao_lisp_string_fetch(int id)
 877 {
 878         char *string = save_string[id];
 879         save_string[id] = NULL;
 880         return string;
 881 }
 882 void
 883 ao_lisp_poly_stash(int id, ao_poly poly)
 884 {
 885         save_poly[id] = poly;
 886 }
 887
 888 ao_poly
 889 ao_lisp_poly_fetch(int id)
 890 {
 891         ao_poly poly = save_poly[id];
 892         save_poly[id] = AO_LISP_NIL;
 893         return poly;
 894 }