2017-04-01 22:26:44 +01:00
|
|
|
/* Copyright (C) 2016 Jeremiah Orians
|
|
|
|
* This file is part of stage0.
|
2017-03-29 01:25:39 +01:00
|
|
|
*
|
|
|
|
* stage0 is free software: you can redistribute it and/or modify
|
|
|
|
* it under the terms of the GNU General Public License as published by
|
|
|
|
* the Free Software Foundation, either version 3 of the License, or
|
|
|
|
* (at your option) any later version.
|
|
|
|
*
|
|
|
|
* stage0 is distributed in the hope that it will be useful,
|
|
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
* GNU General Public License for more details.
|
|
|
|
*
|
|
|
|
* You should have received a copy of the GNU General Public License
|
|
|
|
* along with stage0. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
*/
|
|
|
|
|
2016-12-17 01:59:57 +00:00
|
|
|
#include "lisp.h"
|
|
|
|
|
2017-05-07 02:44:05 +01:00
|
|
|
struct cell *free_cells, *gc_block_start, *top_allocated;
|
2017-02-04 19:27:24 +00:00
|
|
|
int64_t left_to_take;
|
|
|
|
|
|
|
|
int64_t cells_remaining()
|
|
|
|
{
|
|
|
|
return left_to_take;
|
|
|
|
}
|
|
|
|
|
|
|
|
void update_remaining()
|
|
|
|
{
|
|
|
|
int64_t count = 0;
|
|
|
|
struct cell* i = free_cells;
|
|
|
|
while(NULL != i)
|
|
|
|
{
|
|
|
|
count = count + 1;
|
|
|
|
i = i->cdr;
|
|
|
|
}
|
|
|
|
left_to_take = count;
|
|
|
|
}
|
|
|
|
|
2017-05-07 02:44:05 +01:00
|
|
|
struct cell* insert_ordered(struct cell* i, struct cell* list)
|
|
|
|
{
|
|
|
|
if(NULL == list)
|
|
|
|
{
|
|
|
|
return i;
|
|
|
|
}
|
|
|
|
|
|
|
|
if(i < list)
|
|
|
|
{
|
|
|
|
i->cdr = list;
|
|
|
|
return i;
|
|
|
|
}
|
|
|
|
|
|
|
|
list->cdr = insert_ordered(i, list->cdr);
|
|
|
|
return list;
|
|
|
|
}
|
|
|
|
|
2017-02-04 19:27:24 +00:00
|
|
|
void reclaim_marked()
|
|
|
|
{
|
|
|
|
struct cell* i;
|
2017-05-07 02:44:05 +01:00
|
|
|
for(i= top_allocated; i >= gc_block_start ; i = i - 1)
|
2017-02-04 19:27:24 +00:00
|
|
|
{
|
|
|
|
if(i->type & MARKED)
|
|
|
|
{
|
|
|
|
i->type = FREE;
|
|
|
|
i->car = NULL;
|
2017-05-07 02:44:05 +01:00
|
|
|
i->cdr = NULL;
|
2017-02-04 19:27:24 +00:00
|
|
|
i->env = NULL;
|
2017-05-07 02:44:05 +01:00
|
|
|
free_cells = insert_ordered(i, free_cells);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void relocate_cell(struct cell* current, struct cell* target, struct cell* list)
|
|
|
|
{
|
|
|
|
for(; NULL != list; list = list->cdr)
|
|
|
|
{
|
|
|
|
if(list->car == current)
|
|
|
|
{
|
|
|
|
list->car = target;
|
|
|
|
}
|
|
|
|
|
|
|
|
if(list->cdr == current)
|
|
|
|
{
|
|
|
|
list->cdr = target;
|
|
|
|
}
|
|
|
|
|
|
|
|
if(list->env == current)
|
|
|
|
{
|
|
|
|
list->env = target;
|
|
|
|
}
|
|
|
|
|
|
|
|
if((list->type & CONS)|| list->type & PROC )
|
|
|
|
{
|
|
|
|
relocate_cell(current, target, list->car);
|
2017-02-04 19:27:24 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2017-05-07 02:44:05 +01:00
|
|
|
struct cell* pop_cons();
|
|
|
|
void compact(struct cell* list)
|
|
|
|
{
|
|
|
|
for(; NULL != list; list = list->cdr)
|
|
|
|
{
|
|
|
|
if((FREE != list->type) && (list > free_cells ))
|
|
|
|
{
|
|
|
|
struct cell* temp = pop_cons();
|
|
|
|
temp->type = list->type;
|
|
|
|
temp->car = list->car;
|
|
|
|
temp->cdr = list->cdr;
|
|
|
|
temp->env = list->env;
|
|
|
|
relocate_cell(list, temp, all_symbols);
|
|
|
|
relocate_cell(list, temp, top_env);
|
|
|
|
}
|
|
|
|
|
|
|
|
if((list->type & CONS)|| list->type & PROC )
|
|
|
|
{
|
|
|
|
compact(list->car);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
2017-02-04 19:27:24 +00:00
|
|
|
void mark_all_cells()
|
|
|
|
{
|
|
|
|
struct cell* i;
|
2017-05-07 02:44:05 +01:00
|
|
|
for(i= gc_block_start; i < top_allocated; i = i + 1)
|
2017-02-04 19:27:24 +00:00
|
|
|
{
|
|
|
|
/* if not in the free list */
|
|
|
|
if(!(i->type & FREE))
|
|
|
|
{
|
|
|
|
/* Mark it */
|
|
|
|
i->type = i->type | MARKED;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2017-05-20 19:01:46 +01:00
|
|
|
void unmark_cells(struct cell* list, struct cell* stop, int count)
|
2017-02-04 19:27:24 +00:00
|
|
|
{
|
2017-05-20 19:01:46 +01:00
|
|
|
if(count > 1) return;
|
|
|
|
|
2017-02-04 19:27:24 +00:00
|
|
|
for(; NULL != list; list = list->cdr)
|
|
|
|
{
|
2017-05-20 19:01:46 +01:00
|
|
|
if(list == stop) count = count + 1;
|
2017-02-04 19:27:24 +00:00
|
|
|
list->type = list->type & ~MARKED;
|
2017-05-20 19:01:46 +01:00
|
|
|
|
|
|
|
if(list->type & PROC)
|
|
|
|
{
|
|
|
|
unmark_cells(list->car, stop, count);
|
|
|
|
if(NULL != list->env)
|
|
|
|
{
|
|
|
|
unmark_cells(list->env, stop, count);
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
if(list->type & CONS)
|
2017-02-04 19:27:24 +00:00
|
|
|
{
|
2017-05-20 19:01:46 +01:00
|
|
|
unmark_cells(list->car, stop, count);
|
2017-02-04 19:27:24 +00:00
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void garbage_collect()
|
|
|
|
{
|
|
|
|
mark_all_cells();
|
2017-05-20 19:01:46 +01:00
|
|
|
unmark_cells(all_symbols, all_symbols, 0);
|
|
|
|
unmark_cells(top_env, top_env, 0);
|
2017-02-04 19:27:24 +00:00
|
|
|
reclaim_marked();
|
|
|
|
update_remaining();
|
2017-05-07 02:44:05 +01:00
|
|
|
compact(all_symbols);
|
|
|
|
compact(top_env);
|
|
|
|
top_allocated = NULL;
|
2017-02-04 19:27:24 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
void garbage_init()
|
|
|
|
{
|
|
|
|
int number_of_Cells = 1000000;
|
|
|
|
gc_block_start = calloc(number_of_Cells + 1, sizeof(cell));
|
2017-05-07 02:44:05 +01:00
|
|
|
top_allocated = gc_block_start + number_of_Cells;
|
2017-02-04 19:27:24 +00:00
|
|
|
free_cells = NULL;
|
|
|
|
garbage_collect();
|
2017-05-07 02:44:05 +01:00
|
|
|
top_allocated = NULL;
|
2017-02-04 19:27:24 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
struct cell* pop_cons()
|
|
|
|
{
|
|
|
|
if(NULL == free_cells)
|
|
|
|
{
|
|
|
|
printf("OOOPS we ran out of cells");
|
|
|
|
exit(EXIT_FAILURE);
|
|
|
|
}
|
|
|
|
struct cell* i;
|
|
|
|
i = free_cells;
|
|
|
|
free_cells = i->cdr;
|
|
|
|
i->cdr = NULL;
|
2017-05-07 02:44:05 +01:00
|
|
|
if(i > top_allocated)
|
|
|
|
{
|
|
|
|
top_allocated = i;
|
|
|
|
}
|
2017-02-04 19:27:24 +00:00
|
|
|
left_to_take = left_to_take - 1;
|
|
|
|
return i;
|
|
|
|
}
|
|
|
|
|
2016-12-17 01:59:57 +00:00
|
|
|
struct cell* make_int(int a)
|
|
|
|
{
|
2017-02-04 19:27:24 +00:00
|
|
|
struct cell* c = pop_cons();
|
2016-12-17 01:59:57 +00:00
|
|
|
c->type = INT;
|
|
|
|
c->value = a;
|
|
|
|
return c;
|
|
|
|
}
|
|
|
|
|
|
|
|
struct cell* make_sym(char* name)
|
|
|
|
{
|
2017-02-04 19:27:24 +00:00
|
|
|
struct cell* c = pop_cons();
|
2016-12-17 01:59:57 +00:00
|
|
|
c->type = SYM;
|
|
|
|
c->string = name;
|
|
|
|
return c;
|
|
|
|
}
|
|
|
|
|
|
|
|
struct cell* make_cons(struct cell* a, struct cell* b)
|
|
|
|
{
|
2017-02-04 19:27:24 +00:00
|
|
|
struct cell* c = pop_cons();
|
2016-12-17 01:59:57 +00:00
|
|
|
c->type = CONS;
|
|
|
|
c->car = a;
|
|
|
|
c->cdr = b;
|
|
|
|
return c;
|
|
|
|
}
|
|
|
|
|
|
|
|
struct cell* make_proc(struct cell* a, struct cell* b, struct cell* env)
|
|
|
|
{
|
2017-02-04 19:27:24 +00:00
|
|
|
struct cell* c = pop_cons();
|
2016-12-17 01:59:57 +00:00
|
|
|
c->type = PROC;
|
|
|
|
c->car = a;
|
|
|
|
c->cdr = b;
|
|
|
|
c->env = env;
|
|
|
|
return c;
|
|
|
|
}
|
|
|
|
|
|
|
|
struct cell* make_prim(void* fun)
|
|
|
|
{
|
2017-02-04 19:27:24 +00:00
|
|
|
struct cell* c = pop_cons();
|
2016-12-17 01:59:57 +00:00
|
|
|
c->type = PRIMOP;
|
|
|
|
c->function = fun;
|
|
|
|
return c;
|
|
|
|
}
|