Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion examples/library.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,9 @@
(defun list (x . y)
(cons x y))


(defmacro progn (expr . rest)
(list (cons 'lambda (cons () (cons expr rest)))))

;; (and e1 e2 ...)
;; => (if e1 (and e2 ...))
;; (and e1)
Expand Down
74 changes: 74 additions & 0 deletions examples/test
Original file line number Diff line number Diff line change
@@ -0,0 +1,74 @@
; test include
(load "examples/library.lisp")

; Make a set (remove duplicates)
(println(reduce (lambda (acc x)
(if (member acc x)
acc
(cons x acc)))
'(1 2 2 3 1 4 3 5)
()))

; sort

(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (iota 100)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (iota 100)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (reverse (iota 100))))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(reverse (iota 100)))
(println(quicksort (reverse (iota 100))))

(println(reduce (lambda (acc x)
(if (member acc x)
acc
(cons x acc)))
'(1 2 2 3 1 4 3 5)
()))

(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (iota 100)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (iota 100)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (reverse (iota 100))))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (reverse (iota 100))))

(println(reduce (lambda (acc x)
(if (member acc x)
acc
(cons x acc)))
'(1 2 2 3 1 4 3 5)
()))
(println(quicksort (iota 100)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (iota 100)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (iota 100)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (reverse (iota 100))))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8)))
(println(quicksort '(3 1 4 1 5 9 2 8 5 3 5 8 9 8 12 35 48 453 75 90 53 90 456785 785 789)))
(println(quicksort (reverse (iota 100))))

(println(reduce (lambda (acc x)
(if (member acc x)
acc
(cons x acc)))
'(1 2 2 3 1 4 3 5)
()))

74 changes: 36 additions & 38 deletions src/gc.c
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
#include <sys/mman.h>
#include "gc.h"

extern __attribute((noreturn)) void error(char *fmt, ...);
extern void error(char *fmt, ...);

// The pointer pointing to the beginning of the current heap
void *memory;
Expand All @@ -18,32 +18,30 @@ static void *from_space;
static size_t mem_nused = 0;

// Flags to debug GC
static bool gc_running = false;
static bool debug_gc = false;
static bool always_gc = false;
bool gc_running = false;
bool debug_gc = false;
bool always_gc = false;


// The list containing all symbols. Such data structure is traditionally called the "obarray", but I
// avoid using it as a variable name as this is not an array but a list.
extern Obj *Symbols;

static void gc(void *root); // forward decl
Obj *Symbols;

// Round up the given value to a multiple of size. Size must be a power of 2. It adds size - 1
// first, then zero-ing the least significant bits to make the result a multiple of size. I know
// these bit operations may look a little bit tricky, but it's efficient and thus frequently used.
static inline size_t roundup(size_t var, size_t size) {
return (var + size - 1) & ~(size - 1); // 傳回的大小必須是 2 的次方
return (var + size - 1) & ~(size - 1);
}

// Allocates memory block. This may start GC if we don't have enough memory.
Obj *alloc(void *root, int type, size_t size) { // 分配比 size 大的記憶體給 type 的物件
Obj *alloc(void *root, int type, size_t size) {
// The object must be large enough to contain a pointer for the forwarding pointer. Make it
// larger if it's smaller than that.
size = roundup(size, sizeof(void *));

// Add the size of the type tag and size fields.
size += offsetof(Obj, value); // offsetof 的功能 -- 參考 https://en.cppreference.com/w/cpp/types/offsetof
size += offsetof(Obj, value);

// Round up the object size to the nearest alignment boundary, so that the next object will be
// allocated at the proper alignment boundary. Currently we align the object at the same
Expand All @@ -55,20 +53,20 @@ Obj *alloc(void *root, int type, size_t size) { // 分配比 size 大的記憶
// more predictable and repeatable. If there's a memory bug that the C variable has a direct
// reference to a Lisp object, the pointer will become invalid by this GC call. Dereferencing
// that will immediately cause SEGV.
if (always_gc && !gc_running) // 每次分配前都做垃圾收集
if (always_gc && !gc_running)
gc(root);

// Otherwise, run GC only when the available memory is not large enough.
if (!always_gc && MEMORY_SIZE < mem_nused + size) // 只有記憶體不足時才做垃圾收集
if (!always_gc && MEMORY_SIZE < mem_nused + size)
gc(root);

// Terminate the program if we couldn't satisfy the memory request. This can happen if the
// requested size was too large or the from-space was filled with too many live objects.
if (MEMORY_SIZE < mem_nused + size) // heap 記憶體用完了
if (MEMORY_SIZE < mem_nused + size)
error("Memory exhausted");

// Allocate the object.
Obj *obj = memory + mem_nused; // memory: heap 起點 men_nused: 目前用掉的大小。
Obj *obj = memory + mem_nused;
obj->type = type;
obj->size = size;
mem_nused += size;
Expand All @@ -84,12 +82,12 @@ Obj *alloc(void *root, int type, size_t size) { // 分配比 size 大的記憶
// to-space. The objects before "scan1" are the objects that are fully copied. The objects between
// "scan1" and "scan2" have already been copied, but may contain pointers to the from-space. "scan2"
// points to the beginning of the free space.
static Obj *scan1; // Cheney 算法請參考 -- https://blog.csdn.net/MrLiii/article/details/113521913
static Obj *scan2; // scan1, scan2 就是上文中的 SCAN 與 Free
static Obj *scan1;
static Obj *scan2;

// Moves one object from the from-space to the to-space. Returns the object's new address. If the
// object has already been moved, does nothing but just returns the new address.
static inline Obj *forward(Obj *obj) { // 將 obj 從 from 區移到 to 區
static inline Obj *forward(Obj *obj) {
// If the object's address is not in the from-space, the object is not managed by GC nor it
// has already been moved to the to-space.
ptrdiff_t offset = (uint8_t *)obj - (uint8_t *)from_space;
Expand All @@ -98,29 +96,29 @@ static inline Obj *forward(Obj *obj) { // 將 obj 從 from 區移到 to 區

// The pointer is pointing to the from-space, but the object there was a tombstone. Follow the
// forwarding pointer to find the new location of the object.
if (obj->type == TMOVED) // 已經移過去了,不用再移
if (obj->type == TMOVED)
return obj->moved;

// Otherwise, the object has not been moved yet. Move it. // 還沒移過去,開始移
Obj *newloc = scan2; // 目標位址
memcpy(newloc, obj, obj->size); // 移過去
scan2 = (Obj *)((uint8_t *)scan2 + obj->size); // 將 scan2 往後移動
// Otherwise, the object has not been moved yet. Move it.
Obj *newloc = scan2;
memcpy(newloc, obj, obj->size);
scan2 = (Obj *)((uint8_t *)scan2 + obj->size);

// Put a tombstone at the location where the object used to occupy, so that the following call
// of forward() can find the object's new location.
obj->type = TMOVED; // 標示該物件已完成移動
obj->moved = newloc; // 標示該物件的新位址
return newloc; // 傳回該物件的新位址
obj->type = TMOVED;
obj->moved = newloc;
return newloc;
}

void *alloc_semispace() {
return mmap(NULL, MEMORY_SIZE, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANON, -1, 0);
}

// Copies the root objects. // 移動 root 環境的物件
// Copies the root objects.
static void forward_root_objects(void *root) {
Symbols = forward(Symbols); // 移動符號表到新記憶體區
for (void **frame = root; frame; frame = *(void ***)frame) // 移動 frame 到新記憶體區
Symbols = forward(Symbols);
for (void **frame = root; frame; frame = *(void ***)frame)
for (int i = 1; frame[i] != ROOT_END; i++)
if (frame[i])
frame[i] = forward(frame[i]);
Expand All @@ -135,14 +133,14 @@ static bool getEnvFlag(char *name) {

// Implements Cheney's copying garbage collection algorithm.
// http://en.wikipedia.org/wiki/Cheney%27s_algorithm
static void gc(void *root) {
void gc(void *root) {
assert(!gc_running);
gc_running = true; // 開始垃圾蒐集

// Debug flags
debug_gc = getEnvFlag("MINILISP_DEBUG_GC");
always_gc = getEnvFlag("MINILISP_ALWAYS_GC");

// Allocate a new semi-space.
from_space = memory;
memory = alloc_semispace();
Expand All @@ -151,40 +149,40 @@ static void gc(void *root) {
scan1 = scan2 = memory;

// Copy the GC root objects first. This moves the pointer scan2.
forward_root_objects(root); // 移動 root 環境的物件
forward_root_objects(root);

// Copy the objects referenced by the GC root objects located between scan1 and scan2. Once it's
// finished, all live objects (i.e. objects reachable from the root) will have been copied to
// the to-space.
while (scan1 < scan2) { // 將 root 指向的物件從 scan1 (FROM) 搬到 scan2 (to) 去
while (scan1 < scan2) {
switch (scan1->type) {
case TINT:
case TSTRING:
case TSYMBOL:
case TPRIMITIVE:
case TSTRING:
// Any of the above types does not contain a pointer to a GC-managed object.
break;
case TCELL:
scan1->car = forward(scan1->car); // 每個 list 的 car, cdr 都搬到新位址
scan1->car = forward(scan1->car);
scan1->cdr = forward(scan1->cdr);
break;
case TFUNCTION:
case TMACRO:
scan1->params = forward(scan1->params); // 每個 macro 的 params, body, env 都搬到新位址
scan1->params = forward(scan1->params);
scan1->body = forward(scan1->body);
scan1->env = forward(scan1->env);
break;
case TENV:
scan1->vars = forward(scan1->vars); // 每個 env 的 vars, up 都搬到新位址
scan1->vars = forward(scan1->vars);
scan1->up = forward(scan1->up);
break;
default:
error("Bug: copy: unknown type %d", scan1->type);
}
scan1 = (Obj *)((uint8_t *)scan1 + scan1->size); // 前進到下一個物件
scan1 = (Obj *)((uint8_t *)scan1 + scan1->size);
}

// Finish up GC. // 結束垃圾蒐集
// Finish up GC.
munmap(from_space, MEMORY_SIZE);
size_t old_nused = mem_nused;
mem_nused = (size_t)((uint8_t *)scan1 - (uint8_t *)memory);
Expand Down
76 changes: 42 additions & 34 deletions src/gc.h
Original file line number Diff line number Diff line change
Expand Up @@ -10,9 +10,9 @@
//======================================================================

// The size of the heap in byte
#define MEMORY_SIZE 262144
#define MEMORY_SIZE 65536 * 4

extern void *root; // root of memory
extern void *gc_root; // root of memory

// Currently we are using Cheney's copying GC algorithm, with which the available memory is split
// into two halves and all objects are moved from one half to another every time GC is invoked. That
Expand All @@ -34,35 +34,43 @@ extern void *root; // root of memory

#define ROOT_END ((void *)-1)

// 初始化 frame (env) 陣列
#define ADD_ROOT(size) \
void *root_ADD_ROOT_[size + 2]; \
root_ADD_ROOT_[0] = root; \
for (int i = 1; i <= size; i++) \
root_ADD_ROOT_[i] = NULL; \
root_ADD_ROOT_[size + 1] = ROOT_END; \
root = root_ADD_ROOT_
// 新增 1 個變數物件
#define DEFINE1(var1) \
ADD_ROOT(1); \
Obj **var1 = (Obj **)(root_ADD_ROOT_ + 1)
// 新增 2 個變數物件
#define DEFINE2(var1, var2) \
ADD_ROOT(2); \
Obj **var1 = (Obj **)(root_ADD_ROOT_ + 1); \
Obj **var2 = (Obj **)(root_ADD_ROOT_ + 2)
// 新增 3 個變數物件
#define DEFINE3(var1, var2, var3) \
ADD_ROOT(3); \
Obj **var1 = (Obj **)(root_ADD_ROOT_ + 1); \
Obj **var2 = (Obj **)(root_ADD_ROOT_ + 2); \
Obj **var3 = (Obj **)(root_ADD_ROOT_ + 3)
// 新增 4 個變數物件
#define DEFINE4(var1, var2, var3, var4) \
ADD_ROOT(4); \
Obj **var1 = (Obj **)(root_ADD_ROOT_ + 1); \
Obj **var2 = (Obj **)(root_ADD_ROOT_ + 2); \
Obj **var3 = (Obj **)(root_ADD_ROOT_ + 3); \
Obj **var4 = (Obj **)(root_ADD_ROOT_ + 4)

#endif
static inline void** add_root_frame(void **prev_frame, int size, void *frame[]) {
frame[0] = prev_frame;
for (int i = 1; i <= size; i++)
frame[i] = NULL;
frame[size + 1] = ROOT_END;
return frame;
}

#define DEFINE1(prev_frame, var1) \
void *root_frame[3]; \
prev_frame = add_root_frame(prev_frame, 1, root_frame); \
Obj **var1 = (Obj **)(root_frame + 1);

#define DEFINE2(prev_frame, var1, var2) \
void *root_frame[4]; \
prev_frame = add_root_frame(prev_frame, 2, root_frame); \
Obj **var1 = (Obj **)(root_frame + 1); \
Obj **var2 = (Obj **)(root_frame + 2);

#define DEFINE3(prev_frame, var1, var2, var3) \
void *root_frame[5]; \
prev_frame = add_root_frame(prev_frame, 3, root_frame); \
Obj **var1 = (Obj **)(root_frame + 1); \
Obj **var2 = (Obj **)(root_frame + 2); \
Obj **var3 = (Obj **)(root_frame + 3);

#define DEFINE4(prev_frame, var1, var2, var3, var4) \
void *root_frame[6]; \
prev_frame = add_root_frame(prev_frame, 4, root_frame); \
Obj **var1 = (Obj **)(root_frame + 1); \
Obj **var2 = (Obj **)(root_frame + 2); \
Obj **var3 = (Obj **)(root_frame + 3); \
Obj **var4 = (Obj **)(root_frame + 4);


void *alloc_semispace();
Obj *alloc(void *root, int type, size_t size);
void gc(void *root);

#endif
Loading
Loading