More work on x64 backend.

examples/sysir/run_samples.sh

@@ -2,4 +2,4 @@
 build/janet examples/sysir/samples.janet > temp.nasm
 nasm -felf64 temp.nasm -l temp.lst -o temp.o
 ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
-./temp.bin
+valgrind ./temp.bin

examples/sysir/samples.janet

@@ -1,9 +1,13 @@
 (use ./frontend)
 
+(def square
+  '(defn square:int [num:int]
+     (return (* num num))))
+
 (def simple
-  '(defn simple [x:int]
+  '(defn simple:int [x:int]
      (def xyz:int (+ 1 2 3))
-     (return (* x 2 x))))
+     (return (the int (* x 2 x)))))
 
 (def myprog
   '(defn myprog:int []
@@ -16,6 +20,7 @@
        (printf "i = %d\n" i))
      (printf "hello, world!\n%d\n" (the int (if x abc xyz)))
      (return (* abc xyz))))
+     #(return (the int (simple (* abc xyz))))))
 
 (def doloop
   '(defn doloop [x:int y:int]
@@ -35,6 +40,8 @@
 
 ####
 
+#(compile1 square)
+(compile1 simple)
 (compile1 myprog)
 (compile1 doloop)
 (compile1 main-fn)

src/boot/boot.janet

@@ -3050,9 +3050,10 @@
   ``Merge a module source into the `target` environment with a `prefix`, as with the `import` macro.
   This lets users emulate the behavior of `import` with a custom module table.
   If `export` is truthy, then merged functions are not marked as private. Returns
-  the modified target environment.``
+  the modified target environment. If an array `only` is passed, only merge keys in `only`.``
-  [target source &opt prefix export]
+  [target source &opt prefix export only]
-  (loop [[k v] :pairs source :when (symbol? k) :when (not (v :private))]
+  (def only-set (if only (invert only)))
+  (loop [[k v] :pairs source :when (symbol? k) :when (not (v :private)) :when (or (not only) (in only-set k))]
     (def newv (table/setproto @{:private (not export)} v))
     (put target (symbol prefix k) newv))
   target)
@@ -3065,13 +3066,14 @@
   (def kargs (table ;args))
   (def {:as as
         :prefix prefix
-        :export ep} kargs)
+        :export ep
+        :only only} kargs)
   (def newenv (require-1 path args kargs))
   (def prefix (or
                 (and as (string as "/"))
                 prefix
                 (string (last (string/split "/" path)) "/")))
-  (merge-module env newenv prefix ep))
+  (merge-module env newenv prefix ep only))
 
 (defmacro import
   ``Import a module. First requires the module, and then merges its
@@ -3084,7 +3086,7 @@
   module cache.``
   [path & args]
   (def ps (partition 2 args))
-  (def argm (mapcat (fn [[k v]] [k (if (= k :as) (string v) v)]) ps))
+  (def argm (mapcat (fn [[k v]] [k (case k :as (string v) :only ~(quote ,v) v)]) ps))
   (tuple import* (string path) ;argm))
 
 (defmacro use

src/core/sysir_x86.c

@@ -63,7 +63,6 @@ static const char *register_names_xmm[] = {
 };
 
 typedef enum {
-    JANET_SYSREG_STACK, // TODO - one of these is not like the others
     JANET_SYSREG_8,
     JANET_SYSREG_16,
     JANET_SYSREG_32,
@@ -72,8 +71,15 @@ typedef enum {
     JANET_SYSREG_XMM
 } x64RegKind;
 
+typedef enum {
+    JANET_SYSREG_REGISTER,
+    JANET_SYSREG_STACK, /* Indexed from base pointer */
+    JANET_SYSREG_STACK_PARAMETER, /* Index from base pointer in other direction */
+} x64Storage;
+
 typedef struct {
     x64RegKind kind;
+    x64Storage storage;
     uint32_t index;
 } x64Reg;
 
@@ -161,15 +167,6 @@ void assign_registers(JanetSysx64Context *ctx) {
     /* TODO - avoid spills inside loops if possible i.e. not all spills are equal */
     /* TODO - move into sysir.c and allow reuse for multiple targets */
     
-
-    if (ctx->ir->register_count == 0) {
-        ctx->regs = NULL;
-        ctx->frame_size = 0;
-        ctx->occupied_registers = 0;
-        ctx->restore_count = 0;
-        return;
-    }
-
     /* Make trivial assigments */
     uint32_t next_loc = 0;
     ctx->regs = janet_smalloc(ctx->ir->register_count * sizeof(x64Reg));
@@ -179,9 +176,9 @@ void assign_registers(JanetSysx64Context *ctx) {
     assigned |= 1 << RBP;
     assigned |= 1 << RAX; // return reg, div, etc.
     for (uint32_t i = 0; i < ctx->ir->register_count; i++) {
+        ctx->regs[i].kind = get_slot_regkind(ctx, i);
         if (i < ctx->ir->parameter_count) {
             /* Assign to rdi, rsi, etc. according to ABI */
-            ctx->regs[i].kind = get_slot_regkind(ctx, i);
             if (i == 0) ctx->regs[i].index = RDI;
             if (i == 1) ctx->regs[i].index = RSI;
             if (i == 2) ctx->regs[i].index = RDX;
@@ -189,24 +186,27 @@ void assign_registers(JanetSysx64Context *ctx) {
             if (i == 4) ctx->regs[i].index = 8;
             if (i == 5) ctx->regs[i].index = 9;
             if (i >= 6) {
-                janet_assert(0, "more than 6 parameters nyi");
+                janet_panic("nyi");
+                ctx->regs[i].storage = JANET_SYSREG_STACK_PARAMETER;
+            } else {
+                ctx->regs[i].storage = JANET_SYSREG_REGISTER;
+                assigned |= 1 << ctx->regs[i].index;
+                occupied |= 1 << ctx->regs[i].index;
             }
-            assigned |= 1 << ctx->regs[i].index;
-            occupied |= 1 << ctx->regs[i].index;
         } else if (assigned < 0xFFFF) { /* skip r15 so we have some temporary registers if needed */
             /* Assign to register */
             uint32_t to = 0;
             while ((1 << to) & assigned) to++;
-            ctx->regs[i].kind = get_slot_regkind(ctx, i);
             ctx->regs[i].index = to;
+            ctx->regs[i].storage = JANET_SYSREG_REGISTER;
             assigned |= 1 << ctx->regs[i].index;
             occupied |= 1 << ctx->regs[i].index;
         } else { // TODO - also assign stack location if src of address IR instruction
             /* Assign to stack location */
-            ctx->regs[i].kind = JANET_SYSREG_STACK;
             JanetSysTypeLayout layout = ctx->ir_layouts[i];
             next_loc = (next_loc + layout.alignment - 1) / layout.alignment * layout.alignment;
             ctx->regs[i].index = next_loc;
+            ctx->regs[i].storage = JANET_SYSREG_STACK;
             next_loc += layout.size;
         }
     }
@@ -221,7 +221,7 @@ void assign_registers(JanetSysx64Context *ctx) {
     unsigned char tokeep[] = {3, 6, 7, 12, 13, 14, 15};
     for (uint32_t i = 0; i < ctx->ir->register_count; i++) {
         x64Reg reg = ctx->regs[i];
-        if (reg.kind == JANET_SYSREG_STACK) continue;
+        if (reg.storage != JANET_SYSREG_REGISTER) continue;
         for (unsigned int j = 0; j < sizeof(tokeep); j++) {
             if (!seen[j] && reg.index == tokeep[j]) {
                 ctx->to_restore[ctx->restore_count++] = reg.index;
@@ -234,19 +234,23 @@ void assign_registers(JanetSysx64Context *ctx) {
 static int operand_isstack(JanetSysx64Context *ctx, uint32_t o) {
     if (o > JANET_SYS_MAX_OPERAND) return 0; /* constant */
     x64Reg reg = ctx->regs[o];
-    return reg.kind == JANET_SYSREG_STACK;
+    return reg.storage != JANET_SYSREG_REGISTER;
 }
 
 static int operand_isreg(JanetSysx64Context *ctx, uint32_t o, uint32_t regindex) {
     if (o > JANET_SYS_MAX_OPERAND) return 0; /* constant */
     x64Reg reg = ctx->regs[o];
-    if (reg.kind == JANET_SYSREG_STACK) return 0;
+    if (reg.storage != JANET_SYSREG_REGISTER) return 0;
     return reg.index == regindex;
 }
 
 static void sysemit_reg(JanetSysx64Context *ctx, x64Reg reg, const char *after) {
-    if (reg.kind == JANET_SYSREG_STACK) {
+    if (reg.storage == JANET_SYSREG_STACK) {
-        janet_formatb(ctx->buffer, "[rbp - %u]", reg.index);
+        // TODO - use LEA for parameters larger than a qword
+        janet_formatb(ctx->buffer, "[rbp-%u]", reg.index);
+    } else if (reg.storage == JANET_SYSREG_STACK_PARAMETER) {
+        // TODO - use LEA for parameters larger than a qword
+        janet_formatb(ctx->buffer, "[rbp+%u]", reg.index);
     } else if (reg.kind == JANET_SYSREG_64) {
         janet_formatb(ctx->buffer, "%s", register_names[reg.index]);
     } else if (reg.kind == JANET_SYSREG_32) {
@@ -317,6 +321,16 @@ static void sysemit_movreg(JanetSysx64Context *ctx, uint32_t regdest, uint32_t s
     sysemit_operand(ctx, src, "\n");
 }
 
+static void sysemit_movfromreg(JanetSysx64Context *ctx, uint32_t dest, uint32_t srcreg) {
+    if (operand_isreg(ctx, dest, srcreg)) return;
+    x64Reg tempreg;
+    tempreg.kind = get_slot_regkind(ctx, dest);
+    tempreg.index = srcreg;
+    janet_formatb(ctx->buffer, "mov ");
+    sysemit_operand(ctx, dest, ", ");
+    sysemit_reg(ctx, tempreg, "\n");
+}
+
 static void sysemit_pushreg(JanetSysx64Context *ctx, uint32_t dest_reg) {
     janet_formatb(ctx->buffer, "push %s\n", register_names[dest_reg]);
 }
@@ -336,6 +350,22 @@ static void sysemit_threeop(JanetSysx64Context *ctx, const char *op, uint32_t de
     sysemit_binop(ctx, op, dest, rhs);
 }
 
+static void sysemit_threeop_nodeststack(JanetSysx64Context *ctx, const char *op, uint32_t dest, uint32_t lhs,
+        uint32_t rhs) {
+    if (operand_isstack(ctx, dest)) {
+        sysemit_movreg(ctx, RAX, lhs);
+        x64Reg tempreg;
+        tempreg.kind = get_slot_regkind(ctx, dest);
+        tempreg.index = RAX;
+        janet_formatb(ctx->buffer, "%s ", op);
+        sysemit_reg(ctx, tempreg, ", ");
+        sysemit_operand(ctx, lhs, "\n");
+        sysemit_movfromreg(ctx, dest, RAX);
+    } else {
+        sysemit_threeop(ctx, op, dest, lhs, rhs);
+    }
+}
+
 static void sysemit_three_inst(JanetSysx64Context *ctx, const char *op, JanetSysInstruction instruction) {
     sysemit_threeop(ctx, op, instruction.three.dest, instruction.three.lhs, instruction.three.rhs);
 }
@@ -379,9 +409,12 @@ static int sysemit_comp(JanetSysx64Context *ctx, uint32_t index,
         return 1;
     } else {
         /* Set register instead */
-        janet_formatb(ctx->buffer, "%s ", set);
+        x64RegKind kind = get_slot_regkind(ctx, instruction.three.dest);
-        /* Set only byte register */
+        if (kind != JANET_SYSREG_8) {
-        sysemit_operand(ctx, instruction.three.dest, "\n");
+            /* Zero the upper bits */
+            sysemit_binop(ctx, "xor", instruction.three.dest, instruction.three.dest);
+        }
+        janet_formatb(ctx->buffer, "%s %s\n", set, register_names_8[instruction.three.dest]);
         return 0;
     }
 }
@@ -495,7 +528,8 @@ void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetBuffer *buffer)
                     sysemit_three_inst(&ctx, "sub", instruction);
                     break;
                 case JANET_SYSOP_MULTIPLY:
-                    sysemit_three_inst(&ctx, "imul", instruction);
+                    sysemit_threeop_nodeststack(&ctx, "imul", instruction.three.dest,
+                            instruction.three.lhs, instruction.three.rhs);
                     break;
                 case JANET_SYSOP_DIVIDE:
                     sysemit_three_inst(&ctx, "idiv", instruction);