Merge pull request #4 from NJdevPro/extend

Fix crashes

Author: NJdevPro

examples/library.lisp

@@ -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)

examples/test

@@ -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)
+        ()))
+        

src/gc.c

@@ -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;
@@ -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
@@ -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;
@@ -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;
@@ -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]);
@@ -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();
@@ -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);

src/gc.h

@@ -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
@@ -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