Add compilation context

This prepares the compiler for the compilation of lambdas/procedures.

2 files changed, 204 insertions, 149 deletions

diff --git a/src/compiler.h b/src/compiler.h
index 3227eba..64e6df9 100644
--- a/src/compiler.h
+++ b/src/compiler.h
@@ -13,6 +13,16 @@ typedef struct Constant {
 
 static Constant *constants = NULL;
 static char **labels = NULL;
+static char **procedures = NULL;
+
+static char* current_context = NULL;
+#define context_printf(fmt, ...) \
+do { \
+    char buf[KB(4)]; \
+    int n_chars = sprintf(buf, fmt, ##__VA_ARGS__); \
+    array_insert(current_context, buf, n_chars); \
+} while(false);
+
 
 // TODO: Separate c/h files
 // TODO: Create a "driver.c" file with the (display) function for external
@@ -70,27 +80,27 @@ emit_file(char *file_name) {
 
 void
 compile_fixnum(Object *obj) {
-    printf("    ;; --> compile_fixnum\n");
-    printf("    mov     rax, %zu\n", (obj->fixnum << FIXNUM_SHIFT) | FIXNUM_TAG);
-    printf("    push    rax\n");
-    printf("    ;; <-- compile_fixnum\n");
+    context_printf("    ;; --> compile_fixnum\n");
+    context_printf("    mov     rax, %zu\n", (obj->fixnum << FIXNUM_SHIFT) | FIXNUM_TAG);
+    context_printf("    push    rax\n");
+    context_printf("    ;; <-- compile_fixnum\n");
 }
 
 void
 compile_boolean(Object *obj) {
-    printf("    ;; --> compile_boolean\n");
+    context_printf("    ;; --> compile_boolean\n");
     int is_true = obj->type == OBJ_TYPE_TRUE;
-    printf("    mov     rax, %zu\n", (is_true << BOOL_SHIFT) | BOOL_TAG);
-    printf("    push    rax\n");
-    printf("    ;; <-- compile_boolean\n");
+    context_printf("    mov     rax, %zu\n", (is_true << BOOL_SHIFT) | BOOL_TAG);
+    context_printf("    push    rax\n");
+    context_printf("    ;; <-- compile_boolean\n");
 }
 
 void
 compile_nil(void) {
-    printf("    ;; --> compile_nil\n");
-    printf("    mov     rax, NIL_VAL\n");
-    printf("    push    rax\n");
-    printf("    ;; <-- compile_nil\n");
+    context_printf("    ;; --> compile_nil\n");
+    context_printf("    mov     rax, NIL_VAL\n");
+    context_printf("    push    rax\n");
+    context_printf("    ;; <-- compile_nil\n");
 }
 
 typedef enum OpType {
@@ -115,95 +125,95 @@ typedef enum OpType {
 
 void
 compile_type_predicate(OpType op, Object* args) {
-    printf("    ;; --> compile_type_predicate\n");
+    context_printf("    ;; --> compile_type_predicate\n");
     compile_object(args->head);
-    printf("    pop     rax\n");
+    context_printf("    pop     rax\n");
     switch (op) {
         case OP_IS_NIL: {
-            printf("    cmp     rax, NIL_VAL\n");
+            context_printf("    cmp     rax, NIL_VAL\n");
         } break;
         case OP_IS_ZERO: {
-            printf("    cmp     rax, 0\n");
+            context_printf("    cmp     rax, 0\n");
         } break;
         case OP_IS_BOOL: {
-            printf("    and     rax, BOOL_MASK\n");
-            printf("    cmp     rax, BOOL_TAG\n");
+            context_printf("    and     rax, BOOL_MASK\n");
+            context_printf("    cmp     rax, BOOL_TAG\n");
         } break;
         case OP_IS_FIXNUM: {
-            printf("    and     rax, FIXNUM_MASK\n");
-            printf("    cmp     rax, FIXNUM_TAG\n");
+            context_printf("    and     rax, FIXNUM_MASK\n");
+            context_printf("    cmp     rax, FIXNUM_TAG\n");
         } break;
         default: break;
     }
-    printf("    mov     rax, 0\n");
-    printf("    sete    al\n");
-    printf("    shl     rax, BOOL_SHIFT\n");
-    printf("    or      rax, BOOL_TAG\n");
-    printf("    push    rax\n");
-    printf("    ;; <-- compile_type_predicate\n");
+    context_printf("    mov     rax, 0\n");
+    context_printf("    sete    al\n");
+    context_printf("    shl     rax, BOOL_SHIFT\n");
+    context_printf("    or      rax, BOOL_TAG\n");
+    context_printf("    push    rax\n");
+    context_printf("    ;; <-- compile_type_predicate\n");
 }
 
 void
 compile_not(Object* args) {
-    printf("    ;; --> compile_not\n");
+    context_printf("    ;; --> compile_not\n");
     compile_object(args->head);
-    printf("    pop     rax\n");
-    printf("    cmp     rax, FALSE_VAL\n");
-    printf("    mov     rax, 0\n");
-    printf("    sete    al\n");
-    printf("    shl     rax, BOOL_SHIFT\n");
-    printf("    or      rax, BOOL_TAG\n");
-    printf("    push    rax\n");
-    printf("    ;; <-- compile_not\n");
+    context_printf("    pop     rax\n");
+    context_printf("    cmp     rax, FALSE_VAL\n");
+    context_printf("    mov     rax, 0\n");
+    context_printf("    sete    al\n");
+    context_printf("    shl     rax, BOOL_SHIFT\n");
+    context_printf("    or      rax, BOOL_TAG\n");
+    context_printf("    push    rax\n");
+    context_printf("    ;; <-- compile_not\n");
 }
 
 void
 compile_and(Object *args) {
-    printf("    ;; --> compile_and\n");
+    context_printf("    ;; --> compile_and\n");
     char *lab_false = generate_label("BDLL");
     char *lab_exit = generate_label("BDLL");
     while (args != NULL) {
         compile_object(args->head);
         args = args->tail;
-        printf("    pop     rax\n");
-        printf("    cmp     rax, FALSE_VAL\n");
-        printf("    je      %s\n", lab_false);
+        context_printf("    pop     rax\n");
+        context_printf("    cmp     rax, FALSE_VAL\n");
+        context_printf("    je      %s\n", lab_false);
     }
-    printf("    mov     rax, TRUE_VAL\n");
-    printf("    push    rax\n");
-    printf("    jmp     %s\n", lab_exit);
-    printf("%s:\n", lab_false);
-    printf("    mov     rax, FALSE_VAL\n");
-    printf("    push    rax\n");
-    printf("%s:\n", lab_exit);
-    printf("    ;; <-- compile_and\n");
+    context_printf("    mov     rax, TRUE_VAL\n");
+    context_printf("    push    rax\n");
+    context_printf("    jmp     %s\n", lab_exit);
+    context_printf("%s:\n", lab_false);
+    context_printf("    mov     rax, FALSE_VAL\n");
+    context_printf("    push    rax\n");
+    context_printf("%s:\n", lab_exit);
+    context_printf("    ;; <-- compile_and\n");
 }
 
 void
 compile_or(Object *args) {
-    printf("    ;; --> compile_or\n");
+    context_printf("    ;; --> compile_or\n");
     char *lab_true = generate_label("BDLL");
     char *lab_exit = generate_label("BDLL");
     while (args != NULL) {
         compile_object(args->head);
         args = args->tail;
-        printf("    pop     rax\n");
-        printf("    cmp     rax, FALSE_VAL\n");
-        printf("    jne     %s\n", lab_true);
+        context_printf("    pop     rax\n");
+        context_printf("    cmp     rax, FALSE_VAL\n");
+        context_printf("    jne     %s\n", lab_true);
     }
-    printf("    mov     rax, FALSE_VAL\n");
-    printf("    push    rax\n");
-    printf("    jmp     %s\n", lab_exit);
-    printf("%s:\n", lab_true);
-    printf("    mov     rax, TRUE_VAL\n");
-    printf("    push    rax\n");
-    printf("%s:\n", lab_exit);
-    printf("    ;; <-- compile_or\n");
+    context_printf("    mov     rax, FALSE_VAL\n");
+    context_printf("    push    rax\n");
+    context_printf("    jmp     %s\n", lab_exit);
+    context_printf("%s:\n", lab_true);
+    context_printf("    mov     rax, TRUE_VAL\n");
+    context_printf("    push    rax\n");
+    context_printf("%s:\n", lab_exit);
+    context_printf("    ;; <-- compile_or\n");
 }
 
 void
 compile_cmp_list(OpType op, Object* args) {
-    printf("    ;; --> compile_cmp_list\n");
+    context_printf("    ;; --> compile_cmp_list\n");
     compile_object(args->head);
     char *lab_false = generate_label("BDLL");
     char *lab_exit = generate_label("BDLL");
@@ -213,116 +223,116 @@ compile_cmp_list(OpType op, Object* args) {
         args = args->tail;
 
         // Current value.
-        printf("    pop     rcx\n");
+        context_printf("    pop     rcx\n");
 
         // Previous value.
-        printf("    pop     rax\n");
+        context_printf("    pop     rax\n");
 
         // Comparison.
-        printf("    cmp     rax, rcx\n");
+        context_printf("    cmp     rax, rcx\n");
         switch (op) {
-            case OP_EQUAL:      { printf("    jne     %s\n", lab_false); } break;
-            case OP_GREATER:    { printf("    jle     %s\n", lab_false); } break;
-            case OP_LESS:       { printf("    jge     %s\n", lab_false); } break;
-            case OP_GREATER_EQ: { printf("    jl      %s\n", lab_false); } break;
-            case OP_LESS_EQ:    { printf("    jg      %s\n", lab_false); } break;
+            case OP_EQUAL:      { context_printf("    jne     %s\n", lab_false); } break;
+            case OP_GREATER:    { context_printf("    jle     %s\n", lab_false); } break;
+            case OP_LESS:       { context_printf("    jge     %s\n", lab_false); } break;
+            case OP_GREATER_EQ: { context_printf("    jl      %s\n", lab_false); } break;
+            case OP_LESS_EQ:    { context_printf("    jg      %s\n", lab_false); } break;
             default: break;
         }
-        printf("    push    rcx\n");
+        context_printf("    push    rcx\n");
     }
-    printf("    pop     rcx\n");
-    printf("    mov     rax, TRUE_VAL\n");
-    printf("    push    rax\n");
-    printf("    jmp     %s\n", lab_exit);
-    printf("%s:\n", lab_false);
-    printf("    mov     rax, FALSE_VAL\n");
-    printf("    push    rax\n");
-    printf("%s:\n", lab_exit);
-    printf("    ;; <-- compile_cmp_list\n");
+    context_printf("    pop     rcx\n");
+    context_printf("    mov     rax, TRUE_VAL\n");
+    context_printf("    push    rax\n");
+    context_printf("    jmp     %s\n", lab_exit);
+    context_printf("%s:\n", lab_false);
+    context_printf("    mov     rax, FALSE_VAL\n");
+    context_printf("    push    rax\n");
+    context_printf("%s:\n", lab_exit);
+    context_printf("    ;; <-- compile_cmp_list\n");
 }
 
 void
 compile_arithmetic_list(OpType op, Object* args) {
-    printf("    ;; --> compile_arithmetic\n");
+    context_printf("    ;; --> compile_arithmetic\n");
     compile_object(args->head);
     args = args->tail;
     while (args != NULL) {
         compile_object(args->head);
         args = args->tail;
-        printf("    pop     rcx\n");
-        printf("    pop     rax\n");
+        context_printf("    pop     rcx\n");
+        context_printf("    pop     rax\n");
         switch (op) {
-            case OP_ADD: { printf("    add     rax, rcx\n"); } break;
-            case OP_SUB: { printf("    sub     rax, rcx\n"); } break;
+            case OP_ADD: { context_printf("    add     rax, rcx\n"); } break;
+            case OP_SUB: { context_printf("    sub     rax, rcx\n"); } break;
             case OP_MUL: {
-                printf("    sar     rax, FIXNUM_SHIFT\n");
-                printf("    sar     rcx, FIXNUM_SHIFT\n");
-                printf("    mul     rcx\n");
-                printf("    shl     rax, FIXNUM_SHIFT\n");
+                context_printf("    sar     rax, FIXNUM_SHIFT\n");
+                context_printf("    sar     rcx, FIXNUM_SHIFT\n");
+                context_printf("    mul     rcx\n");
+                context_printf("    shl     rax, FIXNUM_SHIFT\n");
             } break;
             case OP_DIV: {
-                printf("    sar     rax, FIXNUM_SHIFT\n");
-                printf("    sar     rcx, FIXNUM_SHIFT\n");
-                printf("    mov     rdx, 0\n");
-                printf("    div     rcx\n");
-                printf("    shl     rax, FIXNUM_SHIFT\n");
+                context_printf("    sar     rax, FIXNUM_SHIFT\n");
+                context_printf("    sar     rcx, FIXNUM_SHIFT\n");
+                context_printf("    mov     rdx, 0\n");
+                context_printf("    div     rcx\n");
+                context_printf("    shl     rax, FIXNUM_SHIFT\n");
             } break;
             case OP_MOD: {
-                printf("    sar     rax, FIXNUM_SHIFT\n");
-                printf("    sar     rcx, FIXNUM_SHIFT\n");
-                printf("    mov     rdx, 0\n");
-                printf("    div     rcx\n");
-                printf("    mov     rax, rdx\n");
-                printf("    shl     rax, FIXNUM_SHIFT\n");
+                context_printf("    sar     rax, FIXNUM_SHIFT\n");
+                context_printf("    sar     rcx, FIXNUM_SHIFT\n");
+                context_printf("    mov     rdx, 0\n");
+                context_printf("    div     rcx\n");
+                context_printf("    mov     rax, rdx\n");
+                context_printf("    shl     rax, FIXNUM_SHIFT\n");
             } break;
             default: break;
         }
-        printf("    push    rax\n");
+        context_printf("    push    rax\n");
     }
-    printf("    ;; <-- compile_arithmetic\n");
+    context_printf("    ;; <-- compile_arithmetic\n");
 }
 
 void
 compile_cons(Object *obj) {
-    printf("    ;; --> compile_cons\n");
+    context_printf("    ;; --> compile_cons\n");
     // Store objects into the car and cdr.
     compile_object(obj->head);
     compile_object(obj->tail->head);
-    printf("    pop     rdx\n");
-    printf("    pop     rax\n");
-    printf("    mov     [r15], rax\n");
-    printf("    mov     [r15 + 8], rdx\n");
+    context_printf("    pop     rdx\n");
+    context_printf("    pop     rax\n");
+    context_printf("    mov     [r15], rax\n");
+    context_printf("    mov     [r15 + 8], rdx\n");
 
     // Push memory address of cons cell.
-    printf("    mov     rax, r15\n");
-    printf("    or      rax, %zu\n", PAIR_TAG);
-    printf("    push    rax\n");
+    context_printf("    mov     rax, r15\n");
+    context_printf("    or      rax, %zu\n", PAIR_TAG);
+    context_printf("    push    rax\n");
 
     // Bump allocation register.
-    printf("    add     r15, 16\n");
-    printf("    ;; <-- compile_cons\n");
+    context_printf("    add     r15, 16\n");
+    context_printf("    ;; <-- compile_cons\n");
 }
 
 void
 compile_car(Object *obj) {
-    printf("    ;; --> compile_car\n");
+    context_printf("    ;; --> compile_car\n");
     compile_object(obj->head);
-    printf("    pop     rax\n");
-    printf("    and     rax, %zu\n", ~PAIR_MASK);
-    printf("    mov     rdx, [rax]\n");
-    printf("    push    rdx\n");
-    printf("    ;; <-- compile_car\n");
+    context_printf("    pop     rax\n");
+    context_printf("    and     rax, %zu\n", ~PAIR_MASK);
+    context_printf("    mov     rdx, [rax]\n");
+    context_printf("    push    rdx\n");
+    context_printf("    ;; <-- compile_car\n");
 }
 
 void
 compile_cdr(Object *obj) {
-    printf("    ;; --> compile_cdr\n");
+    context_printf("    ;; --> compile_cdr\n");
     compile_object(obj->head);
-    printf("    pop     rax\n");
-    printf("    and     rax, %zu\n", ~PAIR_MASK);
-    printf("    mov     rdx, [rax + 8]\n");
-    printf("    push    rdx\n");
-    printf("    ;; <-- compile_cdr\n");
+    context_printf("    pop     rax\n");
+    context_printf("    and     rax, %zu\n", ~PAIR_MASK);
+    context_printf("    mov     rdx, [rax + 8]\n");
+    context_printf("    push    rdx\n");
+    context_printf("    ;; <-- compile_cdr\n");
 }
 
 void
@@ -349,8 +359,8 @@ compile_proc_call(Object *obj) {
         compile_type_predicate(OP_IS_BOOL, obj->tail);
     } else if (sv_equal(&obj->head->text, &STRING("display"))) {
         compile_object(obj->tail->head);
-        printf("    pop     rdi\n");
-        printf("    call    display\n");
+        context_printf("    pop     rdi\n");
+        context_printf("    call    display\n");
     } else if (sv_equal(&obj->head->text, &STRING("not"))) {
         compile_not(obj->tail);
     } else if (sv_equal(&obj->head->text, &STRING("and"))) {
@@ -383,24 +393,24 @@ void
 compile_if(Object *obj) {
     char *lab_false = generate_label("BDLL");
     compile_object(obj->condition);
-    printf("    pop     rax\n");
-    printf("    cmp     rax, FALSE_VAL\n");
-    printf("    je      %s\n", lab_false);
+    context_printf("    pop     rax\n");
+    context_printf("    cmp     rax, FALSE_VAL\n");
+    context_printf("    je      %s\n", lab_false);
     compile_object(obj->expr_true);
     if (obj->expr_false != NULL) {
         char *lab_exit = generate_label("BDLL");
-        printf("    jmp     %s\n", lab_exit);
-        printf("%s:\n", lab_false);
+        context_printf("    jmp     %s\n", lab_exit);
+        context_printf("%s:\n", lab_false);
         compile_object(obj->expr_false);
-        printf("%s:\n", lab_exit);
+        context_printf("%s:\n", lab_exit);
     } else {
-        printf("%s:\n", lab_false);
+        context_printf("%s:\n", lab_false);
     }
 }
 
 void
 compile_string(Object *obj) {
-    printf("    ;; --> compile_string\n");
+    context_printf("    ;; --> compile_string\n");
     Constant c;
 
     // Check if the string is already stored as a constant.
@@ -422,10 +432,33 @@ compile_string(Object *obj) {
     }
 
     // Create a tagged pointer to the label.
-    printf("    mov     rax, %s\n", c.label);
-    printf("    or      rax, STRING_TAG\n");
-    printf("    push    rax\n");
-    printf("    ;; <-- compile_string\n");
+    context_printf("    mov     rax, %s\n", c.label);
+    context_printf("    or      rax, STRING_TAG\n");
+    context_printf("    push    rax\n");
+    context_printf("    ;; <-- compile_string\n");
+}
+
+void
+compile_lambda(Object *obj) {
+    // Create a new compilation context.
+    char *prev_context = current_context;
+    current_context = NULL;
+    array_init(current_context, 0);
+
+    char *name = generate_label("BDLP");
+    context_printf("%s:\n", name);
+    for (size_t i = 0; i < array_size(obj->body); i++) {
+        compile_object(obj->body[i]);
+    }
+    context_printf("    ret\n");
+    context_printf("\n");
+
+    // Restore previous compilation context.
+    array_push(procedures, current_context);
+    current_context = prev_context;
+
+    // TODO: Create tagged pointer with this lambda procedure.
+    // TODO: Push compiled object to the stack.
 }
 
 void
@@ -438,6 +471,7 @@ compile_object(Object *obj) {
         case OBJ_TYPE_PAIR: { compile_proc_call(obj); } break;
         case OBJ_TYPE_STRING: { compile_string(obj); } break;
         case OBJ_TYPE_IF: { compile_if(obj); } break;
+        case OBJ_TYPE_LAMBDA: { compile_lambda(obj); } break;
         default: break;
     }
 }
@@ -478,8 +512,16 @@ compile(Root *roots) {
     // Prepare compilation variables.
     array_init(constants, 0);
     array_init(labels, 0);
+    array_init(procedures, 0);
+    array_init(current_context, 0);
 
-    // Prelude.
+    // Compile program.
+    for (size_t i = 0; i < array_size(roots); i++) {
+        Object *root = roots[i];
+        compile_object(root);
+    }
+
+    // Base defines.
     printf("%%define NIL_VAL      %zu\n", NIL_VAL);
     printf("%%define TRUE_VAL     %zu\n", TRUE_VAL);
     printf("%%define FALSE_VAL    %zu\n", FALSE_VAL);
@@ -496,12 +538,26 @@ compile(Root *roots) {
     printf("%%define STRING_TAG   %zu\n", STRING_TAG);
     printf("%%define HEAP_SIZE    %zu\n", HEAP_SIZE);
     printf("\n");
+
+    // Prelude.
     emit_file(PRELUDE_FILE);
+    printf("\n");
 
-    // Compile program.
-    for (size_t i = 0; i < array_size(roots); i++) {
-        Object *root = roots[i];
-        compile_object(root);
+    // Function definitions.
+    for (size_t i = 0; i < array_size(procedures); i++) {
+        char *ctx = procedures[i];
+        for (size_t i = 0; i < array_size(ctx); i++) {
+            putchar(ctx[i]);
+        }
+    }
+
+    // Main context.
+    printf("global _start\n");
+    printf("_start:\n");
+    printf("    mov     r15, bdl_heap\n");
+    printf("    push    NIL_VAL\n");
+    for (size_t i = 0; i < array_size(current_context); i++) {
+        putchar(current_context[i]);
     }
 
     // Postlude.
@@ -515,6 +571,10 @@ compile(Root *roots) {
         free(labels[i]);
     }
     array_free(labels);
+    for (size_t i = 0; i < array_size(procedures); i++) {
+        array_free(procedures[i]);
+    }
+    array_free(procedures);
 }
 
 #endif // BDL_COMPILER_H
diff --git a/src/x86_64/prelude.asm b/src/x86_64/prelude.asm
index c9ef823..05762b9 100644
--- a/src/x86_64/prelude.asm
+++ b/src/x86_64/prelude.asm
@@ -108,14 +108,9 @@ not_string:
 
     ;; is fixnum?
     mov     rax, rdi
+    and     rax, FIXNUM_MASK
+    cmp     rax, FIXNUM_TAG
+    jne     display_end
     call    printdln
 display_end:
     ret
-
-global  _start
-_start:
-    ;; point `rdi` to the start of the heap.
-    mov     r15, bdl_heap
-
-    ;; make sure the last element in the stack is the nil value.
-    push    NIL_VAL