Begin working on drawing example.

examples/sysir/drawing.janet

@@ -0,0 +1,79 @@
+###
+### Create a .bmp file on linux.
+###
+
+(use ./frontend)
+
+(defpointer p32 uint)
+(defn-external write:void [fd:int mem:pointer size:uint])
+(defn-external exit:void [x:int])
+(defn-external malloc:p32 [x:uint])
+(defn-external free:void [m:p32])
+
+# assume 128x128 32 bit color image
+#   Size : 128 * 128 * 4 + align(14 + 40, 4) = 65592
+#   dib offset : align(14 + 40, 4) = 56
+
+(setdyn :verbose true)
+
+
+(defsys write_32:void [x:uint]
+  (write 1 (address x) 4)
+  (return))
+
+(defsys write_16:void [x:uint]
+  (write 1 (address x) 2)
+  (return))
+
+(defsys write_header:void [w:uint h:uint]
+  (write 1 "BM" 2)
+  (def size:uint (+ 56 (* w h 4)))
+  (write_32 size)
+  (write_32 0)
+  (write_32 56) # pixel array offset
+  # Begin DIB
+  (write_32 40) # dib size
+  (write_32 w)
+  (write_32 h)
+  (write_16 1) # color panes - must be 1
+  (write_16 32) # bits per pixel
+  (write_32 0) # compression method - no compression
+  (write_32 0) # image size - not needed when no compression, 0 should be fine
+  (write_32 8192) # pixels per meter - horizontal resolution
+  (write_32 8192) # pixels per meter - vertical resolution
+  (write_32 0) # number of colors in palette - no palette so 0
+  (write_32 0) # number of "important colors" ignored in practice
+  (write_16 0) # add "gap 1" to align pixel array to multiple of 4 bytes
+  (return))
+
+(defsys draw:void [w:uint h:uint]
+  (def red:uint 0xFFFF0000)
+  (def blue:uint 0xFF0000FF)
+  (def size:uint (* w h 4))
+  (def mem:p32 (malloc size))
+  (store mem (the uint 10))
+  (var y:uint 0)
+  (while (< y h)
+    (var x:uint 0)
+    (while (< x w)
+      #(write_32 (if (< y 32) blue red))
+      (if (> y 64)
+        (write_32 blue)
+        (write_32 red))
+      (set x (+ 1 x)))
+    (set y (+ y 1)))
+  (return))
+
+(defsys main:int []
+  (def w:uint 128)
+  (def h:uint 128)
+  (write_header w h)
+  (draw w h)
+  (return 0))
+
+####
+
+#(dump)
+(print "#include <unistd.h>")
+(dumpc)
+#(dumpx64)

examples/sysir/frontend.janet

@@ -12,6 +12,7 @@
 (def slot-types @{})
 (def functions @{})
 (def type-fields @{})
+(def pointer-derefs @{})
 
 (defn get-slot
   [&opt new-name]
@@ -65,11 +66,14 @@
   (add-prim-type 'float 'f32)
   (add-prim-type 'double 'f64)
   (add-prim-type 'int 's32)
+  (add-prim-type 'uint 'u32)
   (add-prim-type 'long 's64)
   (add-prim-type 'ulong 'u64)
-  (add-prim-type 'pointer 'pointer)
   (add-prim-type 'boolean 'boolean)
   (add-prim-type 's16 's16)
+  (add-prim-type 'byte 'u8)
+  (array/push into ~(type-pointer pointer byte))
+  (make-type 'pointer)
   (sysir/asm ctx into)
   ctx)
 
@@ -177,6 +181,41 @@
             (array/push into ~(move ,slot ,result))
             slot)
 
+          # Address of (& operator in C)
+          'address
+          (do
+            (assert (= 1 (length args)))
+            (def [thing] args)
+            (def [name tp] (type-extract thing 'int))
+            (def result (visit1 thing into false tp))
+            (def slot (get-slot))
+            #(assign-type name 'pointer)
+            (array/push into ~(bind ,slot pointer))
+            (array/push into ~(address ,slot ,result))
+            slot)
+
+          'load
+          (do
+            (assert (= 1 (length args)))
+            (def [thing] args)
+            (def [name tp] (type-extract thing 'pointer))
+            (def result (visit1 thing into false tp))
+            (def slot (get-slot))
+            (def ptype (or type-hint 'char))
+            (array/push into ~(bind ,slot ,ptype))
+            (array/push into ~(load ,slot ,result))
+            slot)
+
+          'store
+          (do
+            (assert (= 2 (length args)))
+            (def [dest value] args)
+            (def [name tp] (type-extract dest 'pointer))
+            (def dest-r (visit1 dest into false tp))
+            (def value-r (visit1 value into false))
+            (array/push into ~(store ,dest-r ,value-r))
+            value-r)
+
           # Assignment
           'set
           (do
@@ -229,15 +268,19 @@
             (assert (< 2 (length args) 4))
             (def [cnd tru fal] args)
             (def condition-slot (visit1 cnd into false 'boolean))
-            (def ret (get-slot))
-            (array/push into ~(bind ,ret ,type-hint))
+            (def ret (if type-hint (get-slot)))
+            (when type-hint (array/push into ~(bind ,ret ,type-hint)))
             (array/push into ~(branch ,condition-slot ,lab))
             # false path
-            (array/push into ~(move ,ret ,(visit1 tru into false type-hint)))
+            (if type-hint
+              (array/push into ~(move ,ret ,(visit1 fal into false type-hint)))
+              (visit1 fal into true))
             (array/push into ~(jump ,lab-end))
             (array/push into lab)
             # true path
-            (array/push into ~(move ,ret ,(visit1 fal into false type-hint)))
+            (if type-hint
+              (array/push into ~(move ,ret ,(visit1 tru into false type-hint)))
+              (visit1 tru into true))
             (array/push into lab-end)
             ret)
 
@@ -376,6 +419,16 @@
       # (eprintf "%.99M" into)
       (sysir/asm ctx into))
 
+    # Declare a pointer type
+    'defpointer
+    (do
+      (def into @[])
+      (def [name element] rest)
+      (def field-types @[])
+      (array/push into ~(type-pointer ,name ,element))
+      # (eprintf "%.99M" into)
+      (sysir/asm ctx into))
+
     # Declare an array type
     'defarray
     (do
@@ -424,7 +477,7 @@
         (each part body
           (visit1 part ir-asm true)))
       (put functions fn-name (freeze signature))
-      # (eprintf "%.99M" ir-asm)
+      (when (dyn :verbose) (eprintf "%.99M" ir-asm))
       (sysir/asm ctx ir-asm))
 
     (errorf "unknown form %p" form)))
@@ -463,5 +516,6 @@
 (defmacro defstruct [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defstruct ,;args))])
 (defmacro defunion [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defunion ,;args))])
 (defmacro defarray [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defarray ,;args))])
+(defmacro defpointer [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defpointer ,;args))])
 (defmacro defn-external [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-external ,;args))])
 (defmacro defsys [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn ,;args))])

examples/sysir/run_drawing.sh

@@ -0,0 +1,5 @@
+#!/usr/bin/env bash
+valgrind build/janet examples/sysir/drawing.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
+valgrind ./temp.bin

examples/sysir/samples.janet

@@ -67,6 +67,6 @@
 
 ####
 
-(dump)
+#(dump)
 #(dumpc)
-#(dumpx64)
+(dumpx64)

src/core/sysir.c

@@ -97,9 +97,9 @@ const char *janet_sysop_names[] = {
     "return", /* JANET_SYSOP_RETURN */
     "jump", /* JANET_SYSOP_JUMP */
     "branch", /* JANET_SYSOP_BRANCH */
-    "branch_not", /* JANET_SYSOP_BRANCH_NOT */
+    "branch-not", /* JANET_SYSOP_BRANCH_NOT */
     "address", /* JANET_SYSOP_ADDRESS */
-    "type-primitive", /* JANET_SYSOP_TYPE_PRIMITIVE */
+    "type-prim", /* JANET_SYSOP_TYPE_PRIMITIVE */
     "type-struct", /* JANET_SYSOP_TYPE_STRUCT */
     "type-bind", /* JANET_SYSOP_TYPE_BIND */
     "arg", /* JANET_SYSOP_ARG */
@@ -553,6 +553,13 @@ static void janet_sysir_init_instructions(JanetSysIR *out, JanetView instruction
                 instr_assert_length(tuple, 3, opvalue);
                 instruction.type_prim.dest_type = instr_read_type_operand(tuple[1], out, READ_TYPE_DEFINITION);
                 instruction.type_prim.prim = instr_read_prim(tuple[2]);
+                if (instruction.type_prim.prim == JANET_PRIM_UNKNOWN ||
+                        instruction.type_prim.prim == JANET_PRIM_STRUCT ||
+                        instruction.type_prim.prim == JANET_PRIM_UNION ||
+                        instruction.type_prim.prim == JANET_PRIM_POINTER ||
+                        instruction.type_prim.prim == JANET_PRIM_ARRAY) {
+                    janet_panic("bad primitive");
+                }
                 janet_v_push(ir, instruction);
                 break;
             }
@@ -1129,7 +1136,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
         JanetSysTypeInfo tinfo = linkage->type_defs[type];
         sysir->error_ctx = janet_wrap_number(i);
         if (tinfo.prim == JANET_PRIM_UNKNOWN) {
-            janet_panicf("in %p, unable to infer type for %s", sysir->error_ctx, rname(sysir, i));
+            janet_panicf("unable to infer type for %s (type %p), %d", rname(sysir, i), tname(sysir, type), type);
         }
     }
 
@@ -1155,7 +1162,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
                 uint32_t ret_type = 0;
                 if (instruction.ret.has_value) {
                     rcheck_const_valid(sysir, instruction.ret.value);
-                    ret_type = sysir->types[instruction.ret.value];
+                    ret_type = janet_sys_optype(sysir, instruction.ret.value);
                 }
                 if (found_return) {
                     if (instruction.ret.has_value && !sysir->has_return_type) {
@@ -1246,7 +1253,7 @@ static void janet_sysir_type_check(JanetSysIR *sysir) {
                 tcheck_boolean(sysir, sysir->types[instruction.three.dest]);
                 break;
             case JANET_SYSOP_ADDRESS:
-                rcheck_pointer(sysir, sysir->types[instruction.two.dest]);
+                rcheck_pointer(sysir, instruction.two.dest);
                 break;
             case JANET_SYSOP_BRANCH:
             case JANET_SYSOP_BRANCH_NOT:
@@ -1523,7 +1530,7 @@ void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
                     break;
                 }
                 case JANET_SYSOP_ADDRESS:
-                    janet_formatb(buffer, "  _r%u = (char *) &", instruction.two.dest);
+                    janet_formatb(buffer, "  _r%u = (void *) &", instruction.two.dest);
                     op_or_const(ir, buffer, instruction.two.src);
                     janet_formatb(buffer, ";\n");
                     break;