Merge branch 'master' into compile-opt

Start setting up a test suite for sysir and work towards emitting jitted
x86 machine code.

.gitignore

@@ -37,6 +37,7 @@ temp.janet
 temp.c
 temp*janet
 temp*.c
+temp.*
 scratch.janet
 scratch.c
 

Makefile

@@ -53,7 +53,7 @@ STRIPFLAGS=-x -S
 HOSTCC?=$(CC)
 HOSTAR?=$(AR)
 # Symbols are (optionally) removed later, keep -g as default!
-CFLAGS?=-O2 -g
+CFLAGS?=-O0 -g
 LDFLAGS?=-rdynamic
 LIBJANET_LDFLAGS?=$(LDFLAGS)
 RUN:=$(RUN)
@@ -138,7 +138,8 @@ JANET_LOCAL_HEADERS=src/core/features.h \
 					src/core/regalloc.h \
 					src/core/compile.h \
 					src/core/emit.h \
-					src/core/symcache.h
+					src/core/symcache.h \
+					src/core/sysir.h
 
 JANET_CORE_SOURCES=src/core/abstract.c \
 				   src/core/array.c \
@@ -173,6 +174,9 @@ JANET_CORE_SOURCES=src/core/abstract.c \
 				   src/core/strtod.c \
 				   src/core/struct.c \
 				   src/core/symcache.c \
+				   src/core/sysir.c \
+				   src/core/sysir_c.c \
+				   src/core/sysir_x86.c \
 				   src/core/table.c \
 				   src/core/tuple.c \
 				   src/core/util.c \

build_win.bat

@@ -20,11 +20,11 @@
 @setlocal
 
 @rem Example use asan
-@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi
-@rem set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib
+@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD /fsanitize=address /Zi /DEBUG
+@set JANET_LINK=link /nologo clang_rt.asan_dynamic-x86_64.lib clang_rt.asan_dynamic_runtime_thunk-x86_64.lib /DEBUG
 
-@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
-@set JANET_LINK=link /nologo
+@rem set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
+@rem set JANET_LINK=link /nologo
 
 @set JANET_LINK_STATIC=lib /nologo
 

examples/sysir/drawing.janet

@@ -0,0 +1,71 @@
+###
+### Create a .bmp file on linux.
+###
+
+# Quick run and view on Linux:
+# build/janet examples/sysir/drawing.janet > temp.c && cc temp.c && ./a.out > temp.bmp && feh temp.bmp
+
+(use ./frontend)
+
+(defn-external write:void [fd:int mem:pointer size:uint])
+(defn-external exit:void [x:int])
+
+# assume 128x128 32 bit color image
+#   Size : 128 * 128 * 4 + align(14 + 40, 4) = 65592
+#   dib offset : align(14 + 40, 4) = 56
+
+(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 4096) # pixels per meter - horizontal resolution
+  (write_32 4096) # 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))
+  (var y:uint 0)
+  (while (< y h)
+    (var x:uint 0)
+    (while (< x w)
+      (write_32 (if (> y 64) blue red))
+      (set x (+ 1 x)))
+    (set y (+ y 1)))
+  (return))
+
+(defsys main:int []
+  (def w:uint 512)
+  (def h:uint 512)
+  (write_header w h)
+  (draw w h)
+  (return 0))
+
+####
+
+#(dump)
+(print "#include <unistd.h>")
+(dumpc)
+#(dumpx64)

examples/sysir/drawing2.janet

@@ -0,0 +1,86 @@
+###
+### Create a .bmp file on linux.
+###
+
+# Quick run and view on Linux:
+# build/janet examples/sysir/drawing2.janet > temp.c && cc temp.c && ./a.out > temp.bmp && feh temp.bmp
+
+(use ./frontend)
+
+(setdyn :verbose true)
+
+# Pointer types
+(defpointer p32 uint)
+(defpointer p16 u16)
+(defpointer cursor p32)
+
+# External
+(defn-external write:void [fd:int mem:pointer size:uint])
+(defn-external exit:void [x:int])
+(defn-external malloc:p32 [size:uint])
+
+(defsys w32:void [c:cursor x:uint]
+  (def p:p32 (load c))
+  (store p x)
+  (store c (the p32 (pointer-add p 1)))
+  (return))
+
+(defsys w16:void [c:cursor x:uint]
+  # Casting needs revisiting
+  (def p:p16 (cast (the p32 (load c))))
+  (store p (the u16 (cast x)))
+  (store c (the p32 (cast (the p16 (pointer-add p 1)))))
+  (return))
+
+(defsys makebmp:p32 [w:uint h:uint]
+  (def size:uint (+ 56 (* w h 4)))
+  (def mem:p32 (malloc size))
+  (def c:cursor (cast (malloc 4)))
+  #(def cursor_data:p32 mem)
+  #(def c:cursor (address cursor_data))
+  (store c mem)
+  (w16 c 0x4D42) # ascii "BM"
+  (w32 c size)
+  (w32 c 0)
+  (w32 c 56)
+  (w32 c 40)
+  (w32 c w)
+  (w32 c h)
+  (w16 c 1)
+  (w16 c 32)
+  (w32 c 0)
+  (w32 c 0)
+  (w32 c 4096)
+  (w32 c 4096)
+  (w32 c 0)
+  (w32 c 0)
+  (w16 c 0) # padding
+  # Draw
+  (def red:uint 0xFFFF0000)
+  (def blue:uint 0xFF0000FF)
+  (def green:uint 0xFF00FF00)
+  (var y:uint 0)
+  (while (< y h)
+    (var x:uint 0)
+    (while (< x w)
+      (def d2:uint (+ (* x x) (* y y)))
+      (if (> d2 100000)
+        (if (> d2 200000) (w32 c green) (w32 c blue))
+        (w32 c red))
+      (set x (+ 1 x)))
+    (set y (+ y 1)))
+  (write 1 mem size)
+  (return mem))
+
+(defsys main:int []
+  (def w:uint 512)
+  (def h:uint 512)
+  (makebmp w h)
+  (return 0))
+
+####
+
+(dumpx64)
+
+#(print "#include <unistd.h>")
+#(dumpc)

examples/sysir/frontend.janet

@@ -0,0 +1,567 @@
+# Make a language frontend for the sysir.
+# Dialect:
+# TODO -
+# * arrays (declaration, loads, stores)
+
+(defdyn *ret-type* "Current function return type")
+
+(def slot-to-name @[])
+(def name-to-slot @{})
+(def type-to-name @[])
+(def name-to-type @{})
+(def slot-types @{})
+(def functions @{})
+(def type-fields @{})
+(def syscalls @{})
+
+(defn get-slot
+  [&opt new-name]
+  (def next-slot (length slot-to-name))
+  (array/push slot-to-name new-name)
+  (if new-name (put name-to-slot new-name next-slot))
+  next-slot)
+
+(defn named-slot
+  [name]
+  (assert (get name-to-slot name)))
+
+(defn make-type
+  [&opt new-name]
+  (def next-type (length type-to-name))
+  (array/push type-to-name new-name)
+  (if new-name (put name-to-type new-name next-type))
+  next-type)
+
+(defn named-type
+  [name]
+  (def t (get name-to-type name))
+  (assert t)
+  t)
+
+(defn binding-type
+  [name]
+  (def slot (assert (get name-to-slot name)))
+  (assert (get slot-types slot)))
+
+(defn slot-type
+  [slot]
+  (assert (get slot-types slot)))
+
+(defn assign-type
+  [name typ]
+  (def slot (get name-to-slot name))
+  (put slot-types slot typ))
+
+(defn assign-slot-type
+  [slot typ]
+  (put slot-types slot typ))
+
+(defn setup-default-types
+  [ctx]
+  (def into @[])
+  (defn add-prim-type
+    [name native-name]
+    (array/push into ~(type-prim ,name ,native-name))
+    (make-type name))
+  (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 'boolean 'boolean)
+  (add-prim-type 's16 's16)
+  (add-prim-type 'u16 'u16)
+  (add-prim-type 'byte 'u8)
+  (add-prim-type 'void 'void)
+  (array/push into ~(type-pointer pointer void))
+  (make-type 'pointer)
+  (sysir/asm ctx into)
+  ctx)
+
+(defn type-extract
+  "Given a symbol:type combination, extract the proper name and the type separately"
+  [combined-name &opt default-type]
+  (def parts (string/split ":" combined-name 0 2))
+  (def [name tp] parts)
+  [(symbol name) (symbol (or tp default-type))])
+
+(var do-binop nil)
+(var do-comp nil)
+
+###
+### Inside functions
+###
+
+(defn visit1
+  "Take in a form and compile code and put it into `into`. Return result slot."
+  [code into &opt no-return type-hint]
+  (def subresult
+      (cond
+
+      # Compile a constant
+      (string? code) ~(pointer ,code)
+      (boolean? code) ~(boolean ,code)
+      (number? code) ~(,(or type-hint 'double) ,code) # TODO - should default to double
+
+      # Needed?
+      (= :core/u64 (type code)) ~(ulong ,code)
+      (= :core/s64 (type code)) ~(long ,code)
+
+      # Binding
+      (symbol? code)
+      (named-slot code)
+
+      # Array literals
+      (and (tuple? code) (= :brackets (tuple/type code)))
+      (do
+        (assert type-hint (string/format "unknown type for array literal %v" code))
+        ~(,type-hint ,code))
+
+      # Compile forms
+      (and (tuple? code) (= :parens (tuple/type code)))
+      (do
+        (assert (> (length code) 0))
+        (def [op & args] code)
+        (case op
+
+          # Arithmetic
+          '+ (do-binop 'add args into type-hint)
+          '- (do-binop 'subtract args into type-hint)
+          '* (do-binop 'multiply args into type-hint)
+          '/ (do-binop 'divide args into type-hint)
+          '<< (do-binop 'shl args into type-hint)
+          '>> (do-binop 'shr args into type-hint)
+
+          # Comparison
+          '= (do-comp 'eq args into)
+          'not= (do-comp 'neq args into)
+          '< (do-comp 'lt args into)
+          '<= (do-comp 'lte args into)
+          '> (do-comp 'gt args into)
+          '>= (do-comp 'gte args into)
+
+          # Pointers
+          'pointer-add
+          (do
+            (assert (= 2 (length args)))
+            (def [base offset] args)
+            (def base-slot (visit1 base into false type-hint))
+            (def offset-slot (visit1 offset into false 'int))
+            (def slot (get-slot))
+            (when type-hint (array/push into ~(bind ,slot ,type-hint)))
+            (array/push into ~(pointer-add ,slot ,base-slot ,offset-slot))
+            slot)
+
+          'pointer-sub
+          (do
+            (assert (= 2 (length args)))
+            (def [base offset] args)
+            (def base-slot (visit1 base into false type-hint))
+            (def offset-slot (visit1 offset into false 'int))
+            (def slot (get-slot))
+            (when type-hint (array/push into ~(bind ,slot ,type-hint)))
+            (array/push into ~(pointer-subtract ,slot ,base-slot ,offset-slot))
+            slot)
+
+          # Type hinting
+          'the
+          (do
+            (assert (= 2 (length args)))
+            (def [xtype x] args)
+            (def result (visit1 x into false xtype))
+            (if (tuple? result) # constant
+              (let [[t y] result]
+                (assertf (= t xtype) "type mismatch, %p doesn't match %p" t xtype)
+                [xtype y])
+              (do
+                (array/push into ~(bind ,result ,xtype))
+                result)))
+
+          # Casting
+          'cast
+          (do
+            (assert (= 1 (length args)))
+            (assert type-hint) # should we add an explicit cast type?
+            (def [x] args)
+            (def slot (get-slot))
+            (def result (visit1 x into false))
+            (array/push into ~(bind ,slot ,type-hint))
+            (array/push into ~(cast ,slot ,result))
+            slot)
+
+          # Named bindings
+          'def
+          (do
+            (assert (= 2 (length args)))
+            (def [full-name value] args)
+            (assert (symbol? full-name))
+            (def [name tp] (type-extract full-name 'int))
+            (def result (visit1 value into false tp))
+            (def slot (get-slot name))
+            (assign-type name tp)
+            (array/push into ~(bind ,slot ,tp))
+            (array/push into ~(move ,slot ,result))
+            slot)
+
+          # Named variables
+          'var
+          (do
+            (assert (= 2 (length args)))
+            (def [full-name value] args)
+            (assert (symbol? full-name))
+            (def [name tp] (type-extract full-name 'int))
+            (def result (visit1 value into false tp))
+            (def slot (get-slot name))
+            (assign-type name tp)
+            (array/push into ~(bind ,slot ,tp))
+            (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))
+            # 
+            (array/push into ~(bind ,slot ,type-hint))
+            (array/push into ~(address ,slot ,result))
+            slot)
+
+          'load
+          (do
+            (assert (= 1 (length args)))
+            (assert type-hint)
+            (def [thing] args)
+            # (def [name tp] (type-extract thing 'pointer))
+            (def result (visit1 thing into false))
+            (def slot (get-slot))
+            (def ptype type-hint)
+            (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))
+            (def value-r (visit1 value into false))
+            (array/push into ~(store ,dest-r ,value-r))
+            value-r)
+
+          # Assignment
+          'set
+          (do
+            (assert (= 2 (length args)))
+            (def [to x] args)
+            (def type-hint (binding-type to))
+            (def result (visit1 x into false type-hint))
+            (def toslot (named-slot to))
+            (array/push into ~(move ,toslot ,result))
+            toslot)
+
+          # Return
+          'return
+          (do
+            (assert (>= 1 (length args)))
+            (if (empty? args)
+              (array/push into '(return))
+              (do
+                (def [x] args)
+                (array/push into ~(return ,(visit1 x into false (dyn *ret-type*))))))
+            nil)
+
+          # Sequence of operations
+          'do
+          (do
+            (each form (slice args 0 -2) (visit1 form into true))
+            (visit1 (last args) into false type-hint))
+
+          # While loop
+          'while
+          (do
+            (def lab-test (keyword (gensym)))
+            (def lab-exit (keyword (gensym)))
+            (assert (< 1 (length args)))
+            (def [cnd & body] args)
+            (array/push into lab-test)
+            (def condition-slot (visit1 cnd into false 'boolean))
+            (array/push into ~(branch-not ,condition-slot ,lab-exit))
+            (each code body
+              (visit1 code into true))
+            (array/push into ~(jump ,lab-test))
+            (array/push into lab-exit)
+            nil)
+
+          # Branch
+          'if
+          (do
+            (def lab (keyword (gensym)))
+            (def lab-end (keyword (gensym)))
+            (assert (< 2 (length args) 4))
+            (def [cnd tru fal] args)
+            (def condition-slot (visit1 cnd into false 'boolean))
+            (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
+            (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
+            (if type-hint
+              (array/push into ~(move ,ret ,(visit1 tru into false type-hint)))
+              (visit1 tru into true))
+            (array/push into lab-end)
+            ret)
+
+          # Insert IR
+          'ir
+          (do
+            (assert no-return)
+            (array/push into ;args)
+            nil)
+
+          # Assume function call or syscall
+          (do
+            (def slots @[])
+            (def signature (get functions op))
+            (def is-syscall (get syscalls op))
+            (assert signature (string "unknown function " op))
+            (def ret (if no-return nil (get-slot)))
+            (when ret
+              (array/push into ~(bind ,ret ,(first signature)))
+              (assign-type ret (first signature)))
+            (each [arg-type arg] (map tuple (drop 1 signature) args)
+              (array/push slots (visit1 arg into false arg-type)))
+            (if is-syscall
+              (array/push into ~(syscall :default ,ret (int ,is-syscall) ,;slots))
+              (array/push into ~(call :default ,ret [pointer ,op] ,;slots)))
+            ret)))
+
+      (errorf "cannot compile %q" code)))
+
+  # Check type-hint matches return type
+  (if type-hint
+    (when-let [t (first subresult)] # TODO - Disallow empty types
+      (assert (= type-hint t) (string/format "%j, expected type %v, got %v" code type-hint t))))
+
+  subresult)
+
+(varfn do-binop
+  "Emit an operation such as (+ x y).
+  Extended to support any number of arguments such as (+ x y z ...)"
+  [opcode args into type-hint]
+  (var typ type-hint)
+  (var final nil)
+  (def slots @[])
+  (each arg args
+    (def right (visit1 arg into false typ))
+    (when (number? right) (array/push slots right))
+
+    # If we don't have a type hint, infer types from bottom up
+    (when (nil? typ)
+      (when-let [new-typ (get slot-types right)]
+        (set typ new-typ)))
+
+    (set final
+         (if final
+           (let [result (get-slot)]
+             (array/push slots result)
+             (array/push into ~(,opcode ,result ,final ,right))
+             result)
+           right)))
+  (assert typ (string "unable to infer type for %j" [opcode ;args]))
+  (each slot (distinct slots)
+    (array/push into ~(bind ,slot ,typ)))
+  (assert final))
+
+(varfn do-comp
+  "Emit a comparison form such as (= x y z ...)"
+  [opcode args into]
+  (def result (get-slot))
+  (def needs-temp (> 2 (length args)))
+  (def temp-result (if needs-temp (get-slot) nil))
+  (array/push into ~(bind ,result boolean))
+  (when needs-temp
+    (array/push into ~(bind ,temp-result boolean)))
+  (var left nil)
+  (var first-compare true)
+  (var typ nil)
+  (each arg args
+    (def right (visit1 arg into false typ))
+    # If we don't have a type hint, infer types from bottom up
+    (when (nil? typ)
+      (when-let [new-typ (get slot-types right)]
+        (set typ new-typ)))
+    (when left
+      (if first-compare
+        (array/push into ~(,opcode ,result ,left ,right))
+        (do
+          (array/push into ~(,opcode ,temp-result ,left ,right))
+          (array/push into ~(and ,result ,temp-result ,result))))
+      (set first-compare false))
+    (set left right))
+  result)
+
+###
+### Top level
+###
+
+(defn top
+  "Visit and emit code for a top level form."
+  [ctx form]
+  (assert (tuple? form))
+  (def [head & rest] form)
+  (case head
+
+    # Declare a struct
+    'defstruct
+    (do
+      (def into @[])
+      (def [name & fields] rest)
+      (assert (even? (length fields)) "expected an even number of fields for struct definition")
+      (def field-types @[])
+      (each [field-name typ] (partition 2 fields)
+        # TODO - don't ignore field names
+        (array/push field-types typ))
+      (array/push into ~(type-struct ,name ,;field-types))
+      # (eprintf "%.99M" into)
+      (sysir/asm ctx into))
+
+    # Declare a union
+    'defunion
+    (do
+      (def into @[])
+      (def [name & fields] rest)
+      (assert (even? (length fields)) "expected an even number of fields for struct definition")
+      (def field-types @[])
+      (each [field-name typ] (partition 2 fields)
+        # TODO - don't ignore field names
+        (array/push field-types typ))
+      (array/push into ~(type-union ,name ,;field-types))
+      # (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
+      (def into @[])
+      (def [name element cnt] rest)
+      (assert (and (pos? cnt) (int? cnt)) "expected positive integer for array count")
+      (array/push into ~(type-array ,name ,element ,cnt))
+      # (eprintf "%.99M" into)
+      (sysir/asm ctx into))
+    
+    # External function
+    'defn-external
+    (do
+      (def [name args] rest)
+      (assert (tuple? args))
+      (def [fn-name fn-tp] (type-extract name 'void))
+      (def pcount (length args)) #TODO - more complicated signatures
+      (def signature @[fn-tp])
+      (each arg args
+        (def [name tp] (type-extract arg 'int))
+        (array/push signature tp))
+      (put functions fn-name (freeze signature)))
+
+    # External syscall
+    'defn-syscall
+    (do
+      (def [name sysnum args] rest)
+      (assert (tuple? args))
+      (def [fn-name fn-tp] (type-extract name 'void))
+      (def pcount (length args)) #TODO - more complicated signatures
+      (def signature @[fn-tp])
+      (each arg args
+        (def [name tp] (type-extract arg 'int))
+        (array/push signature tp))
+      (put syscalls fn-name sysnum)
+      (put functions fn-name (freeze signature)))
+
+    # Top level function definition
+    'defn
+    (do
+      # TODO doc strings
+      (table/clear name-to-slot)
+      (table/clear slot-types)
+      (array/clear slot-to-name)
+      (def [name args & body] rest)
+      (assert (tuple? args))
+      (def [fn-name fn-tp] (type-extract name 'void))
+      (def pcount (length args)) #TODO - more complicated signatures
+      (def ir-asm
+        @[~(link-name ,(string fn-name))
+          ~(parameter-count ,pcount)])
+      (def signature @[fn-tp])
+      (each arg args
+        (def [name tp] (type-extract arg 'int))
+        (def slot (get-slot name))
+        (assign-type name tp)
+        (array/push signature tp)
+        (array/push ir-asm ~(bind ,slot ,tp)))
+      (with-dyns [*ret-type* fn-tp]
+        (each part body
+          (visit1 part ir-asm true)))
+      (put functions fn-name (freeze signature))
+      (when (dyn :verbose) (eprintf "%.99M" ir-asm))
+      (sysir/asm ctx ir-asm))
+
+    (errorf "unknown form %p" form)))
+
+###
+### Setup
+###
+
+(def ctx (sysir/context))
+(setup-default-types ctx)
+
+(defn compile1
+  [x]
+  (top ctx x))
+
+(defn dump
+  []
+  (eprintf "%.99M\n" (sysir/to-ir ctx)))
+
+(defn dumpx64
+  []
+  (print (sysir/to-x64 ctx)))
+
+(defn dumpx64-windows
+  []
+  (print (sysir/to-x64 ctx @"" :windows)))
+
+(defn dumpc
+  []
+  (print (sysir/to-c ctx)))
+
+###
+### Top Level aliases
+###
+
+(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 defn-syscall [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn-syscall ,;args))])
+(defmacro defsys [& args] [compile1 ~',(keep-syntax! (dyn *macro-form*) ~(defn ,;args))])

examples/sysir/hello.janet

@@ -0,0 +1,16 @@
+(use ./frontend)
+
+(defn-external printf:int [fmt:pointer])
+(defn-external exit:void [x:int])
+
+(defsys _start:void []
+  (printf "hello, world!\n")
+  (exit (the int 0))
+  (return))
+
+(defn main [& args]
+  (def [_ what] args)
+  (eprint "MODE: " what)
+  (case what
+    "c" (dumpc)
+    "x64" (dumpx64)))

examples/sysir/run_drawing.sh

@@ -0,0 +1,5 @@
+#!/usr/bin/env bash
+valgrind build/janet examples/sysir/drawing.janet > temp.c
+cc temp.c
+./a.out > temp.bmp
+feh temp.bmp

examples/sysir/run_drawing2.sh

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

@@ -0,0 +1,4 @@
+janet.exe examples/sysir/windows_samples.janet > temp.nasm
+nasm -fwin64 temp.nasm -l temp.lst -o temp.o
+link /entry:Start /subsystem:windows kernel32.lib user32.lib temp.o /out:temp.exe
+temp.exe

examples/sysir/run_samples.sh

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

examples/sysir/samples.janet

@@ -0,0 +1,72 @@
+(use ./frontend)
+
+(defstruct vec3
+   a float
+   b float
+   c float)
+
+(defunion myunion
+  a float
+  b double
+  c long)
+
+(defarray myvec float 4)
+(defarray mymat myvec 4)
+
+(defn-external printf:int [fmt:pointer x:int]) # TODO varargs
+
+(defn-external exit:void [x:int])
+
+(defsys square:int
+  [num:int]
+  (return (* 1 num num)))
+
+(defsys simple:int [x:int]
+  (def xyz:int (+ 1 2 3))
+  (return (* x 2 x)))
+
+(defsys myprog:int []
+  (def xyz:int (+ 1 2 3))
+  (def abc:int (* 4 5 6))
+  (def x:boolean (= xyz 5))
+  (var i:int 0)
+  (while (< i 10)
+    (set i (+ 1 i))
+    (printf "i = %d\n" i))
+  (printf "hello, world!\n%d\n" (if x abc xyz))
+  (return (simple (* abc xyz))))
+
+(defsys doloop [x:int y:int]
+  (var i:int x)
+  (while (< i y)
+    (set i (+ 1 i))
+    (printf "i = %d\n" i))
+  (myprog)
+  (return x))
+
+(defsys _start:void []
+  #(syscall 1 1 "Hello, world!\n" 14)
+  (doloop 10 20)
+  (exit (the int 0))
+  (return))
+
+(defsys test_inttypes:ulong []
+  (def x:ulong 123:u)
+  (return (+ x x)))
+
+(defsys test_arrays:myvec [a:myvec b:myvec]
+  (return (+ a b)))
+
+'(defsys make_array:myvec []
+  (def vec:myvec [0 0 0 0])
+  (return vec))
+
+'(defsys make_mat:mymat []
+  (def mat:mymat [[1 0 0 0] [0 1 0 0] [0 0 1 0] [0 0 0 1]])
+  (return mat))
+
+####
+
+#(dump)
+#(dumpc)
+(dumpx64)

examples/sysir/typeerr1.janet

@@ -0,0 +1,10 @@
+(def ir-asm
+  '((link-name "redefine_type_fail")
+    (type-prim Real f32)
+    (type-prim 1 s32)
+    (bind bob Real)
+    (return bob)))
+
+(def ctx (sysir/context))
+(sysir/asm ctx ir-asm)
+(print (sysir/to-c ctx))

examples/sysir/windows_samples.janet

@@ -0,0 +1,14 @@
+(use ./frontend)
+
+(def winmain
+  '(defn Start:void []
+     (MessageBoxExA (the pointer 0) "Hello, world!" "Test" 0 (the s16 0))
+     (ExitProcess (the int 0))
+     (return)))
+
+####
+
+(compile1 winmain)
+#(dump)
+#(dumpc)
+(dumpx64-windows)

examples/sysir/x64.janet

@@ -0,0 +1,24 @@
+(use ./frontend)
+
+(defn-external printf:int [fmt:pointer x:int])
+(defn-external exit:void [x:int])
+
+(defsys doloop [x:int y:int]
+  (var i:int x)
+  (printf "initial i = %d\n" i)
+  (while (< i y)
+    (set i (+ 1 i))
+    (printf "i = %d\n" i))
+  (return x))
+
+(defsys _start:void []
+  (doloop 10 20)
+  (exit (the int 0))
+  (return))
+
+(defn main [& args]
+  (def [_ what] args)
+  (eprint "MODE: " what)
+  (case what
+    "c" (dumpc)
+    "x64" (dumpx64)))

meson.build

@@ -126,7 +126,8 @@ core_headers = [
   'src/core/regalloc.h',
   'src/core/compile.h',
   'src/core/emit.h',
-  'src/core/symcache.h'
+  'src/core/symcache.h',
+  'src/core/sysir.h',
 ]
 
 core_src = [
@@ -163,6 +164,9 @@ core_src = [
   'src/core/strtod.c',
   'src/core/struct.c',
   'src/core/symcache.c',
+  'src/core/sysir.c',
+  'src/core/sysir_c.c',
+  'src/core/sysir_x86.c',
   'src/core/table.c',
   'src/core/tuple.c',
   'src/core/util.c',
@@ -297,6 +301,7 @@ test_files = [
   'test/suite-strtod.janet',
   'test/suite-struct.janet',
   'test/suite-symcache.janet',
+  'test/suite-sysir.janet',
   'test/suite-table.janet',
   'test/suite-tuple.janet',
   'test/suite-unknown.janet',

src/boot/boot.janet

@@ -2292,8 +2292,8 @@
 
 (defn thaw
   `Thaw an object (make it mutable) and do a deep copy, making
-  child value also mutable. Closures, fibers, and abstract
-  types will not be recursively thawed, but all other types will`
+  child values also mutable. Closures, fibers, and abstract
+  types will not be recursively thawed, but all other types will.`
   [ds]
   (case (type ds)
     :array (walk-ind thaw ds)
@@ -4865,7 +4865,8 @@
      "src/core/regalloc.h"
      "src/core/compile.h"
      "src/core/emit.h"
-     "src/core/symcache.h"])
+     "src/core/symcache.h"
+     "src/core/sysir.h"])
 
   (def core-sources
     ["src/core/abstract.c"
@@ -4901,6 +4902,9 @@
      "src/core/strtod.c"
      "src/core/struct.c"
      "src/core/symcache.c"
+     "src/core/sysir.c"
+     "src/core/sysir_c.c"
+     "src/core/sysir_x86.c"
      "src/core/table.c"
      "src/core/tuple.c"
      "src/core/util.c"

src/core/abstract.c

@@ -164,7 +164,7 @@ void janet_os_mutex_lock(JanetOSMutex *mutex) {
 
 void janet_os_mutex_unlock(JanetOSMutex *mutex) {
     int ret = pthread_mutex_unlock((pthread_mutex_t *) mutex);
-    if (ret) janet_panic("cannot release lock");
+    if (ret) janet_panicf("cannot release lock: %s", strerror(ret));
 }
 
 void janet_os_rwlock_init(JanetOSRWLock *rwlock) {

src/core/compile.c

@@ -1127,4 +1127,5 @@ void janet_lib_compile(JanetTable *env) {
         JANET_REG_END
     };
     janet_core_cfuns_ext(env, NULL, cfuns);
+    janet_lib_sysir(env);
 }

src/core/compile.h

@@ -268,6 +268,9 @@ JanetSlot janetc_cslot(Janet x);
 /* Search for a symbol */
 JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
 
+/* Load the system dialect IR */
+void janet_lib_sysir(JanetTable *env);
+
 /* Bytecode optimization */
 void janet_bytecode_movopt(JanetFuncDef *def);
 void janet_bytecode_remove_noops(JanetFuncDef *def);

src/core/gc.c

@@ -132,7 +132,7 @@ static void janet_mark_many(const Janet *values, int32_t n) {
     }
 }
 
-/* Mark a bunch of key values items in memory */
+/* Mark only the keys from a sequence of key-value pairs */
 static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
     const JanetKV *end = kvs + n;
     while (kvs < end) {
@@ -141,7 +141,7 @@ static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
     }
 }
 
-/* Mark a bunch of key values items in memory */
+/* Mark only the values from a sequence of key-value pairs */
 static void janet_mark_values(const JanetKV *kvs, int32_t n) {
     const JanetKV *end = kvs + n;
     while (kvs < end) {
@@ -150,7 +150,7 @@ static void janet_mark_values(const JanetKV *kvs, int32_t n) {
     }
 }
 
-/* Mark a bunch of key values items in memory */
+/* Mark key-value pairs */
 static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
     const JanetKV *end = kvs + n;
     while (kvs < end) {

src/core/net.c

@@ -1021,6 +1021,7 @@ struct sockopt_type {
 /* List of supported socket options; The type JANET_POINTER is used
  * for options that require special handling depending on the type. */
 static const struct sockopt_type sockopt_type_list[] = {
+    { "tcp-nodelay",  IPPROTO_TCP, TCP_NODELAY, JANET_BOOLEAN },
     { "so-broadcast", SOL_SOCKET, SO_BROADCAST, JANET_BOOLEAN },
     { "so-reuseaddr", SOL_SOCKET, SO_REUSEADDR, JANET_BOOLEAN },
     { "so-keepalive", SOL_SOCKET, SO_KEEPALIVE, JANET_BOOLEAN },
@@ -1042,6 +1043,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
               "- :so-broadcast boolean\n"
               "- :so-reuseaddr boolean\n"
               "- :so-keepalive boolean\n"
+              "- :tcp-nodelay boolean\n"
               "- :ip-multicast-ttl number\n"
               "- :ip-add-membership string\n"
               "- :ip-drop-membership string\n"

src/core/sysir.h

@@ -0,0 +1,337 @@
+/*
+* Copyright (c) 2024 Calvin Rose
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in the Software without restriction, including without limitation the
+* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+* sell copies of the Software, and to permit persons to whom the Software is
+* furnished to do so, subject to the following conditions:
+*
+* The above copyright notice and this permission notice shall be included in
+* all copies or substantial portions of the Software.
+*
+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+* IN THE SOFTWARE.
+*/
+
+/****
+ * The System Dialect Intermediate Representation (sysir) is a compiler intermediate representation
+ * that for "System Janet" a dialect for "System Programming". Sysir can then be retargeted to C or direct to machine
+ * code for JIT or AOT compilation.
+ */
+
+/* TODO
+ * [x] encode constants directly in 3 address codes - makes codegen easier
+ * [x] typed constants
+ * [x] named registers and types
+ * [x] better type errors (perhaps mostly for compiler debugging - full type system goes on top)
+ * [-] x86/x64 machine code target - in progress
+ *   [ ] handle floating point types
+ *   [ ] handle array types
+ *   [ ] emit machine code directly
+ * [ ] target specific extensions - custom instructions and custom primitives
+ * [ ] better casting semantics
+ * [x] separate pointer arithmetic from generalized arithmetic (easier to instrument code for safety)?
+ * [x] fixed-size array types
+ * [x] recursive pointer types
+ * [ ] global and thread local state
+ * [x] union types?
+ * [x] incremental compilation - save type definitions for later
+ * [ ] Extension to C target for interfacing with Janet
+ * [x] pointer math, pointer types
+ * [x] composite types - support for load, store, move, and function args.
+ * [x] Have some mechanism for field access (dest = src.offset)
+ * [x] Related, move type creation as opcodes like in SPIRV - have separate virtual "type slots" and value slots for this.
+ * [x] support for stack allocation of arrays
+ * [ ] more math intrinsics
+ * [x] source mapping (using built in Janet source mapping metadata on tuples)
+ * [x] unit type or void type
+ * [ ] (typed) function pointer types and remove calling untyped pointers
+ * [x] APL array semantics for binary operands (maybe?)
+ * [ ] a few built-in array combinators (maybe?)
+ * [ ] multiple error messages in one pass
+ * [ ] better verification of constants
+ * [x] don't allow redefining types
+ * [ ] generate elf/mach-o/pe directly
+ *   [ ] elf
+ *   [ ] mach-o
+ *   [ ] pe
+ * [ ] generate dwarf info
+ */
+
+#ifndef JANET_SYSIR_H
+#define JANET_SYSIR_H
+
+#ifndef JANET_AMALG
+#include "features.h"
+#include <janet.h>
+#include "state.h"
+#endif
+
+typedef enum {
+    JANET_PRIM_U8,
+    JANET_PRIM_S8,
+    JANET_PRIM_U16,
+    JANET_PRIM_S16,
+    JANET_PRIM_U32,
+    JANET_PRIM_S32,
+    JANET_PRIM_U64,
+    JANET_PRIM_S64,
+    JANET_PRIM_F32,
+    JANET_PRIM_F64,
+    JANET_PRIM_POINTER,
+    JANET_PRIM_BOOLEAN,
+    JANET_PRIM_STRUCT,
+    JANET_PRIM_UNION,
+    JANET_PRIM_ARRAY,
+    JANET_PRIM_VOID,
+    JANET_PRIM_UNKNOWN
+} JanetPrim;
+
+typedef struct {
+    const char *name;
+    JanetPrim prim;
+} JanetPrimName;
+
+typedef enum {
+    JANET_SYSOP_LINK_NAME,
+    JANET_SYSOP_PARAMETER_COUNT,
+    JANET_SYSOP_CALLING_CONVENTION,
+    JANET_SYSOP_MOVE,
+    JANET_SYSOP_CAST,
+    JANET_SYSOP_ADD,
+    JANET_SYSOP_SUBTRACT,
+    JANET_SYSOP_MULTIPLY,
+    JANET_SYSOP_DIVIDE,
+    JANET_SYSOP_BAND,
+    JANET_SYSOP_BOR,
+    JANET_SYSOP_BXOR,
+    JANET_SYSOP_BNOT,
+    JANET_SYSOP_SHL,
+    JANET_SYSOP_SHR,
+    JANET_SYSOP_LOAD,
+    JANET_SYSOP_STORE,
+    JANET_SYSOP_GT,
+    JANET_SYSOP_LT,
+    JANET_SYSOP_EQ,
+    JANET_SYSOP_NEQ,
+    JANET_SYSOP_GTE,
+    JANET_SYSOP_LTE,
+    JANET_SYSOP_CALL,
+    JANET_SYSOP_SYSCALL,
+    JANET_SYSOP_RETURN,
+    JANET_SYSOP_JUMP,
+    JANET_SYSOP_BRANCH,
+    JANET_SYSOP_BRANCH_NOT,
+    JANET_SYSOP_ADDRESS,
+    JANET_SYSOP_TYPE_PRIMITIVE,
+    JANET_SYSOP_TYPE_STRUCT,
+    JANET_SYSOP_TYPE_BIND,
+    JANET_SYSOP_ARG,
+    JANET_SYSOP_FIELD_GETP,
+    JANET_SYSOP_ARRAY_GETP,
+    JANET_SYSOP_ARRAY_PGETP,
+    JANET_SYSOP_TYPE_POINTER,
+    JANET_SYSOP_TYPE_ARRAY,
+    JANET_SYSOP_TYPE_UNION,
+    JANET_SYSOP_POINTER_ADD,
+    JANET_SYSOP_POINTER_SUBTRACT,
+    JANET_SYSOP_LABEL
+} JanetSysOp;
+
+typedef struct {
+    JanetPrim prim;
+    union {
+        struct {
+            uint32_t field_count;
+            uint32_t field_start;
+        } st;
+        struct {
+            uint32_t type;
+        } pointer;
+        struct {
+            uint32_t type;
+            uint64_t fixed_count;
+        } array;
+    };
+} JanetSysTypeInfo;
+
+typedef struct {
+    uint32_t type;
+} JanetSysTypeField;
+
+#define JANET_SYS_CALLFLAG_HAS_DEST 1
+#define JANET_SYS_CALLFLAG_VARARGS 2
+
+/* Allow read arguments to be constants to allow
+ * encoding immediates. This makes codegen easier. */
+#define JANET_SYS_MAX_OPERAND      0x7FFFFFFFU
+#define JANET_SYS_CONSTANT_PREFIX  0x80000000U
+
+typedef enum {
+    JANET_SYS_CC_DEFAULT, /* Reasonable default - maps to a specific cc based on target */
+    JANET_SYS_CC_SYSCALL, /* Reasonable default for platform syscalls - maps to a specific cc based on target */
+    JANET_SYS_CC_X86_CDECL,
+    JANET_SYS_CC_X86_STDCALL,
+    JANET_SYS_CC_X86_FASTCALL,
+    JANET_SYS_CC_X64_SYSV,
+    JANET_SYS_CC_X64_SYSV_SYSCALL,
+    JANET_SYS_CC_X64_WINDOWS,
+} JanetSysCallingConvention;
+
+typedef enum {
+    JANET_SYS_TARGET_X64_WINDOWS, /* 64 bit, modern windows */
+    JANET_SYS_TARGET_X64_LINUX, /* x64 linux with recent kernel */
+} JanetSysTarget;
+
+typedef struct {
+    JanetSysOp opcode;
+    union {
+        struct {
+            uint32_t dest;
+            uint32_t lhs;
+            uint32_t rhs;
+        } three;
+        struct {
+            uint32_t dest;
+            uint32_t callee;
+            uint32_t arg_count;
+            uint8_t flags;
+            JanetSysCallingConvention calling_convention;
+        } call;
+        struct {
+            uint32_t dest;
+            uint32_t src;
+        } two;
+        struct {
+            uint32_t src;
+        } one;
+        struct {
+            uint32_t to;
+        } jump;
+        struct {
+            uint32_t cond;
+            uint32_t to;
+        } branch;
+        struct {
+            uint32_t dest_type;
+            uint32_t prim;
+        } type_prim;
+        struct {
+            uint32_t dest_type;
+            uint32_t arg_count;
+        } type_types;
+        struct {
+            uint32_t dest;
+            uint32_t type;
+        } type_bind;
+        struct {
+            uint32_t args[3];
+        } arg;
+        struct {
+            uint32_t r;
+            uint32_t st;
+            uint32_t field;
+        } field;
+        struct {
+            uint32_t dest_type;
+            uint32_t type;
+            // Include address space?
+        } pointer;
+        struct {
+            uint32_t dest_type;
+            uint32_t type;
+            uint64_t fixed_count;
+        } array;
+        struct {
+            uint32_t id;
+        } label;
+        struct {
+            uint32_t value;
+            uint32_t has_value;
+        } ret;
+    };
+    int32_t line;
+    int32_t column;
+} JanetSysInstruction;
+
+/* Shared data between multiple
+ * IR Function bodies. Used to link
+ * multiple functions together in a
+ * single executable or shared object with
+ * multiple entry points. Contains shared
+ * type declarations, as well as a table of linked
+ * functions. */
+typedef struct {
+    uint32_t old_type_def_count;
+    uint32_t type_def_count;
+    uint32_t field_def_count;
+    JanetSysTypeInfo *type_defs;
+    JanetString *type_names;
+    JanetSysTypeField *field_defs;
+    JanetTable *irs;
+    JanetArray *ir_ordered;
+    JanetTable *type_name_lookup;
+} JanetSysIRLinkage;
+
+/* Keep source code information as well as
+ * typing information along with constants */
+typedef struct {
+    uint32_t type;
+    Janet value;
+    // TODO - source and line
+} JanetSysConstant;
+
+/* IR representation for a single function.
+ * Allow for incremental compilation and linking. */
+typedef struct {
+    JanetSysIRLinkage *linkage;
+    JanetString link_name;
+    uint32_t instruction_count;
+    uint32_t register_count;
+    uint32_t constant_count;
+    uint32_t return_type;
+    uint32_t has_return_type;
+    uint32_t parameter_count;
+    uint32_t label_count;
+    uint32_t *types;
+    JanetSysInstruction *instructions;
+    JanetString *register_names;
+    JanetSysConstant *constants;
+    JanetTable *register_name_lookup;
+    JanetTable *labels;
+    JanetSysCallingConvention calling_convention;
+    Janet error_ctx; /* Temporary for holding error messages */
+} JanetSysIR;
+
+/* Delay alignment info for the most part to the lowering phase */
+typedef struct {
+    uint32_t size;
+    uint32_t alignment;
+} JanetSysTypeLayout;
+
+/* Keep track of names for each instruction */
+extern const char *janet_sysop_names[];
+extern const char *prim_to_prim_name[];
+
+/* Utilities */
+
+uint32_t janet_sys_optype(JanetSysIR *ir, uint32_t op);
+
+/* Get list of uint32_t instruction arguments from a call or other variable length instruction.
+   Needs to be free with janet_sfree (or you can leak it and the garbage collector will eventually clean
+ * it up). */
+uint32_t *janet_sys_callargs(JanetSysInstruction *instr, uint32_t *count);
+
+/* Lowering */
+void janet_sys_ir_lower_to_ir(JanetSysIRLinkage *linkage, JanetArray *into);
+void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer);
+void janet_sys_ir_lower_to_x64(JanetSysIRLinkage *linkage, JanetSysTarget target, JanetBuffer *buffer);
+
+#endif

src/core/sysir_c.c

@@ -0,0 +1,376 @@
+/*
+* Copyright (c) 2024 Calvin Rose
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in the Software without restriction, including without limitation the
+* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+* sell copies of the Software, and to permit persons to whom the Software is
+* furnished to do so, subject to the following conditions:
+*
+* The above copyright notice and this permission notice shall be included in
+* all copies or substantial portions of the Software.
+*
+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+* IN THE SOFTWARE.
+*/
+
+#ifndef JANET_AMALG
+#include "features.h"
+#include <janet.h>
+#include "sysir.h"
+#include "vector.h"
+#include "util.h"
+#endif
+
+/* Lowering to C */
+
+static const char *c_prim_names[] = {
+    "uint8_t",
+    "int8_t",
+    "uint16_t",
+    "int16_t",
+    "uint32_t",
+    "int32_t",
+    "uint64_t",
+    "int64_t",
+    "float",
+    "double",
+    "void *",
+    "bool",
+    "!!!struct",
+    "!!!union",
+    "!!!array",
+    "void",
+    "!!!unknown"
+};
+
+/* Print a C constant */
+static void print_const_c(JanetSysIR *ir, JanetBuffer *buf, Janet c, uint32_t tid) {
+    /* JanetSysTypeInfo *tinfo = &ir->linkage->type_defs[tid]; */
+    if (janet_checktype(c, JANET_TUPLE)) {
+        const Janet *elements = janet_unwrap_tuple(c);
+        janet_formatb(buf, "((_t%d){", tid);
+        for (int32_t i = 0; i < janet_tuple_length(elements); i++) {
+            if (i > 0) janet_formatb(buf, ", ");
+            /* TODO - limit recursion? */
+            uint32_t sub_type = ir->linkage->type_defs[tid].array.type;
+            print_const_c(ir, buf, elements[i], sub_type);
+        }
+        janet_formatb(buf, "})");
+    } else if (janet_checktype(c, JANET_ABSTRACT)) {
+        /* Allow printing int types */
+        janet_formatb(buf, "%V", c);
+    } else {
+        janet_formatb(buf, "%v", c);
+    }
+}
+
+static void c_op_or_const(JanetSysIR *ir, JanetBuffer *buf, uint32_t reg) {
+    if (reg < JANET_SYS_MAX_OPERAND) {
+        janet_formatb(buf, "_r%u", reg);
+    } else {
+        uint32_t constant_id = reg - JANET_SYS_CONSTANT_PREFIX;
+        uint32_t tid = ir->constants[constant_id].type;
+        Janet c = ir->constants[constant_id].value;
+        print_const_c(ir, buf, c, tid);
+    }
+}
+
+static void c_emit_binop(JanetSysIR *ir, JanetBuffer *buffer, JanetBuffer *tempbuf, JanetSysInstruction instruction, const char *op, int pointer_sugar) {
+    uint32_t operand_type = ir->types[instruction.three.dest];
+    tempbuf->count = 0;
+    uint32_t index_index = 0;
+    int is_pointer = 0;
+    JanetSysIRLinkage *linkage = ir->linkage;
+
+    /* Top-level pointer semantics */
+    if (pointer_sugar && janet_sys_optype(ir, instruction.three.dest) == JANET_PRIM_POINTER) {
+        operand_type = linkage->type_defs[operand_type].pointer.type;
+        is_pointer = 1;
+    }
+
+    /* Add nested for loops for any dimensionality of array */
+    while (linkage->type_defs[operand_type].prim == JANET_PRIM_ARRAY) {
+        janet_formatb(buffer, "  for (size_t _j%u = 0; _j%u < %u; _j%u++) ",
+                      index_index, index_index,
+                      linkage->type_defs[operand_type].array.fixed_count,
+                      index_index);
+        if (is_pointer) {
+            janet_formatb(tempbuf, "->els[_j%u]", index_index);
+            is_pointer = 0;
+        } else {
+            janet_formatb(tempbuf, ".els[_j%u]", index_index);
+        }
+        operand_type = linkage->type_defs[operand_type].array.type;
+        index_index++;
+    }
+
+    if (is_pointer) {
+        janet_formatb(buffer, "  *_r%u = *_r%u %s *_r%u;\n",
+                      instruction.three.dest,
+                      instruction.three.lhs,
+                      op,
+                      instruction.three.rhs);
+        janet_formatb(buffer, "  *_r%u = *", instruction.three.dest);
+        c_op_or_const(ir, buffer, instruction.three.lhs);
+        janet_formatb(buffer, " %s ", op);
+        c_op_or_const(ir, buffer, instruction.three.rhs);
+        janet_formatb(buffer, ";\n");
+    } else {
+        Janet index_part = janet_wrap_buffer(tempbuf);
+        janet_formatb(buffer, "  _r%u%V = ", instruction.three.dest, index_part);
+        c_op_or_const(ir, buffer, instruction.three.lhs);
+        janet_formatb(buffer, "%V %s ", index_part, op);
+        c_op_or_const(ir, buffer, instruction.three.rhs);
+        janet_formatb(buffer, "%V;\n", index_part);
+    }
+}
+
+void janet_sys_ir_lower_to_c(JanetSysIRLinkage *linkage, JanetBuffer *buffer) {
+
+    JanetBuffer *tempbuf = janet_buffer(0);
+
+#define EMITBINOP(OP) c_emit_binop(ir, buffer, tempbuf, instruction, OP, 1)
+#define EMITBINOP_NOSUGAR(OP) c_emit_binop(ir, buffer, tempbuf, instruction, OP, 0)
+
+    /* Prelude */
+    janet_formatb(buffer, "#include <stddef.h>\n#include <unistd.h>\n#include <stdlib.h>\n#include <stdint.h>\n#include <stdbool.h>\n#include <stdio.h>\n#include <sys/syscall.h>\n#define _t0 void\n\n");
+
+    /* Emit type defs */
+    for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
+        JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]);
+        for (uint32_t i = 0; i < ir->instruction_count; i++) {
+            JanetSysInstruction instruction = ir->instructions[i];
+            switch (instruction.opcode) {
+                default:
+                    continue;
+                case JANET_SYSOP_TYPE_PRIMITIVE:
+                case JANET_SYSOP_TYPE_STRUCT:
+                case JANET_SYSOP_TYPE_UNION:
+                case JANET_SYSOP_TYPE_POINTER:
+                case JANET_SYSOP_TYPE_ARRAY:
+                    break;
+            }
+            if (instruction.line > 0) {
+                janet_formatb(buffer, "#line %d\n", instruction.line);
+            }
+            switch (instruction.opcode) {
+                default:
+                    break;
+                case JANET_SYSOP_TYPE_PRIMITIVE:
+                    janet_formatb(buffer, "typedef %s _t%u;\n", c_prim_names[instruction.type_prim.prim], instruction.type_prim.dest_type);
+                    break;
+                case JANET_SYSOP_TYPE_STRUCT:
+                case JANET_SYSOP_TYPE_UNION:
+                    janet_formatb(buffer, (instruction.opcode == JANET_SYSOP_TYPE_STRUCT) ? "typedef struct {\n" : "typedef union {\n");
+                    for (uint32_t j = 0; j < instruction.type_types.arg_count; j++) {
+                        uint32_t offset = j / 3 + 1;
+                        uint32_t index = j % 3;
+                        JanetSysInstruction arg_instruction = ir->instructions[i + offset];
+                        janet_formatb(buffer, "    _t%u _f%u;\n", arg_instruction.arg.args[index], j);
+                    }
+                    janet_formatb(buffer, "} _t%u;\n", instruction.type_types.dest_type);
+                    break;
+                case JANET_SYSOP_TYPE_POINTER:
+                    janet_formatb(buffer, "typedef _t%u *_t%u;\n", instruction.pointer.type, instruction.pointer.dest_type);
+                    break;
+                case JANET_SYSOP_TYPE_ARRAY:
+                    janet_formatb(buffer, "typedef struct { _t%u els[%u]; } _t%u;\n", instruction.array.type, instruction.array.fixed_count, instruction.array.dest_type);
+                    break;
+            }
+        }
+    }
+
+    /* Emit function header */
+    for (uint32_t j = 0; j < (uint32_t) linkage->ir_ordered->count; j++) {
+        JanetSysIR *ir = janet_unwrap_abstract(linkage->ir_ordered->data[j]);
+        if (ir->link_name == NULL) {
+            continue;
+        }
+        janet_formatb(buffer, "\n\n_t%u %s(", ir->return_type, (ir->link_name != NULL) ? ir->link_name : janet_cstring("_thunk"));
+        for (uint32_t i = 0; i < ir->parameter_count; i++) {
+            if (i) janet_buffer_push_cstring(buffer, ", ");
+            janet_formatb(buffer, "_t%u _r%u", ir->types[i], i);
+        }
+        janet_buffer_push_cstring(buffer, ")\n{\n");
+        for (uint32_t i = ir->parameter_count; i < ir->register_count; i++) {
+            janet_formatb(buffer, "    _t%u _r%u;\n", ir->types[i], i);
+        }
+        janet_buffer_push_cstring(buffer, "\n");
+
+        /* Emit body */
+        for (uint32_t i = 0; i < ir->instruction_count; i++) {
+            JanetSysInstruction instruction = ir->instructions[i];
+            if (instruction.line > 0) {
+                janet_formatb(buffer, "#line %d\n", instruction.line);
+            }
+            switch (instruction.opcode) {
+                case JANET_SYSOP_TYPE_PRIMITIVE:
+                case JANET_SYSOP_TYPE_BIND:
+                case JANET_SYSOP_TYPE_STRUCT:
+                case JANET_SYSOP_TYPE_UNION:
+                case JANET_SYSOP_TYPE_POINTER:
+                case JANET_SYSOP_TYPE_ARRAY:
+                case JANET_SYSOP_ARG:
+                case JANET_SYSOP_LINK_NAME:
+                case JANET_SYSOP_PARAMETER_COUNT:
+                case JANET_SYSOP_CALLING_CONVENTION:
+                    break;
+                case JANET_SYSOP_LABEL: {
+                    janet_formatb(buffer, "\n_label_%u:\n", instruction.label.id);
+                    break;
+                }
+                case JANET_SYSOP_ADDRESS:
+                    janet_formatb(buffer, "  _r%u = (void *) &", instruction.two.dest);
+                    c_op_or_const(ir, buffer, instruction.two.src);
+                    janet_formatb(buffer, ";\n");
+                    break;
+                case JANET_SYSOP_JUMP:
+                    janet_formatb(buffer, "  goto _label_%u;\n", instruction.jump.to);
+                    break;
+                case JANET_SYSOP_BRANCH:
+                case JANET_SYSOP_BRANCH_NOT:
+                    janet_formatb(buffer, instruction.opcode == JANET_SYSOP_BRANCH ? "  if (" : "  if (!");
+                    c_op_or_const(ir, buffer, instruction.branch.cond);
+                    janet_formatb(buffer, ") goto _label_%u;\n", instruction.branch.to);
+                    break;
+                case JANET_SYSOP_RETURN:
+                    if (instruction.ret.has_value) {
+                        janet_buffer_push_cstring(buffer, "  return ");
+                        c_op_or_const(ir, buffer, instruction.ret.value);
+                        janet_buffer_push_cstring(buffer, ";\n");
+                    } else {
+                        janet_buffer_push_cstring(buffer, "  return;\n");
+                    }
+                    break;
+                case JANET_SYSOP_ADD:
+                    EMITBINOP("+");
+                    break;
+                case JANET_SYSOP_POINTER_ADD:
+                    EMITBINOP_NOSUGAR("+");
+                    break;
+                case JANET_SYSOP_SUBTRACT:
+                    EMITBINOP("-");
+                    break;
+                case JANET_SYSOP_POINTER_SUBTRACT:
+                    EMITBINOP_NOSUGAR("-");
+                    break;
+                case JANET_SYSOP_MULTIPLY:
+                    EMITBINOP("*");
+                    break;
+                case JANET_SYSOP_DIVIDE:
+                    EMITBINOP("/");
+                    break;
+                case JANET_SYSOP_GT:
+                    EMITBINOP(">");
+                    break;
+                case JANET_SYSOP_GTE:
+                    EMITBINOP(">");
+                    break;
+                case JANET_SYSOP_LT:
+                    EMITBINOP("<");
+                    break;
+                case JANET_SYSOP_LTE:
+                    EMITBINOP("<=");
+                    break;
+                case JANET_SYSOP_EQ:
+                    EMITBINOP("==");
+                    break;
+                case JANET_SYSOP_NEQ:
+                    EMITBINOP("!=");
+                    break;
+                case JANET_SYSOP_BAND:
+                    EMITBINOP("&");
+                    break;
+                case JANET_SYSOP_BOR:
+                    EMITBINOP("|");
+                    break;
+                case JANET_SYSOP_BXOR:
+                    EMITBINOP("^");
+                    break;
+                case JANET_SYSOP_SHL:
+                    EMITBINOP("<<");
+                    break;
+                case JANET_SYSOP_SHR:
+                    EMITBINOP(">>");
+                    break;
+                case JANET_SYSOP_SYSCALL:
+                case JANET_SYSOP_CALL: {
+                    if (instruction.call.flags & JANET_SYS_CALLFLAG_HAS_DEST) {
+                        janet_formatb(buffer, "  _r%u = ", instruction.call.dest);
+                    } else {
+                        janet_formatb(buffer, "  ");
+                    }
+                    if (instruction.opcode == JANET_SYSOP_SYSCALL) {
+                        janet_formatb(buffer, "syscall(");
+                        c_op_or_const(ir, buffer, instruction.call.callee);
+                    } else {
+                        c_op_or_const(ir, buffer, instruction.call.callee);
+                        janet_formatb(buffer, "(");
+                    }
+                    uint32_t count;
+                    uint32_t *args = janet_sys_callargs(ir->instructions + i, &count);
+                    for (uint32_t j = 0; j < count; j++) {
+                        if (j || instruction.opcode == JANET_SYSOP_SYSCALL) janet_formatb(buffer, ", ");
+                        c_op_or_const(ir, buffer, args[j]);
+                    }
+                    janet_formatb(buffer, ");\n");
+                    break;
+                }
+                case JANET_SYSOP_CAST: {
+                    uint32_t to = ir->types[instruction.two.dest];
+                    janet_formatb(buffer, "  _r%u = (_t%u) ", instruction.two.dest, to);
+                    c_op_or_const(ir, buffer, instruction.two.src);
+                    janet_formatb(buffer, ";\n");
+                    break;
+                }
+                case JANET_SYSOP_MOVE:
+                    janet_formatb(buffer, "  _r%u = ", instruction.two.dest);
+                    c_op_or_const(ir, buffer, instruction.two.src);
+                    janet_formatb(buffer, ";\n");
+                    break;
+                case JANET_SYSOP_BNOT:
+                    janet_formatb(buffer, "  _r%u = ~", instruction.two.dest);
+                    c_op_or_const(ir, buffer, instruction.two.src);
+                    janet_formatb(buffer, ";\n");
+                    break;
+                case JANET_SYSOP_LOAD:
+                    janet_formatb(buffer, "  _r%u = *(", instruction.two.dest);
+                    c_op_or_const(ir, buffer, instruction.two.src);
+                    janet_formatb(buffer, ");\n");
+                    break;
+                case JANET_SYSOP_STORE:
+                    janet_formatb(buffer, "  *(_r%u) = ", instruction.two.dest);
+                    c_op_or_const(ir, buffer, instruction.two.src);
+                    janet_formatb(buffer, ";\n");
+                    break;
+                case JANET_SYSOP_FIELD_GETP:
+                    janet_formatb(buffer, "  _r%u = &(_r%u._f%u);\n", instruction.field.r, instruction.field.st, instruction.field.field);
+                    janet_formatb(buffer, "  _r%u = &(", instruction.field.r);
+                    janet_formatb(buffer, "._f%u);\n", instruction.field.field);
+                    break;
+                case JANET_SYSOP_ARRAY_GETP:
+                    janet_formatb(buffer, "  _r%u = &(_r%u.els[", instruction.three.dest, instruction.three.lhs);
+                    c_op_or_const(ir, buffer, instruction.three.rhs);
+                    janet_buffer_push_cstring(buffer, "]);\n");
+                    break;
+                case JANET_SYSOP_ARRAY_PGETP:
+                    janet_formatb(buffer, "  _r%u = &(_r%u->els[", instruction.three.dest, instruction.three.lhs);
+                    c_op_or_const(ir, buffer, instruction.three.rhs);
+                    janet_buffer_push_cstring(buffer, "]);\n");
+                    break;
+            }
+        }
+
+        janet_buffer_push_cstring(buffer, "}\n");
+#undef EMITBINOP
+#undef EMITBINOP_NOSUGAR
+    }
+
+}

test/helper.janet

@@ -27,7 +27,7 @@
   (if x
     (when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
     (do
-      (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
+      (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (string e) x) (eflush)))
   x)
 
 (defn skip-asserts

test/suite-boot.janet

@@ -990,6 +990,17 @@
 (assert (= () '() (macex '())) "macex ()")
 (assert (= '[] (macex '[])) "macex []")
 
+# Knuth man or boy test
+(var a nil)
+(defn man-or-boy [x] (a x |1 |-1 |-1 |1 |0))
+(varfn a [k x1 x2 x3 x4 x5]
+  (var k k)
+  (defn b [] (-- k) (a k b x1 x2 x3 x4))
+  (if (<= k 0)
+    (+ (x4) (x5))
+    (b)))
+(assert (= -2 (man-or-boy 2)))
+(assert (= -67 (man-or-boy 10)))
 (assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
 (assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
 

test/suite-sysir.janet

@@ -0,0 +1,50 @@
+# Copyright (c) 2025 Calvin Rose
+#
+# Permission is hereby granted, free of charge, to any person obtaining a copy
+# of this software and associated documentation files (the "Software"), to
+# deal in the Software without restriction, including without limitation the
+# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the Software, and to permit persons to whom the Software is
+# furnished to do so, subject to the following conditions:
+#
+# The above copyright notice and this permission notice shall be included in
+# all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+# IN THE SOFTWARE.
+
+(import ./helper :prefix "" :exit true)
+(start-suite)
+
+(use ../examples/sysir/frontend)
+(assert true) # smoke test
+
+(def janet (dyn *executable*))
+(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
+
+(defn do-expect-directory
+  "Iterate a directory, evaluating all scripts in the directory. Assert that the captured output of the script
+  is as expected according to a matching .expect file."
+  [dir]
+  (each path (sorted (os/dir dir))
+    (when (string/has-suffix? ".janet" path)
+      (def fullpath (string dir "/" path))
+      (def proc (os/spawn [;run janet fullpath] :p {:out :pipe :err :out}))
+      (def buff @"")
+      (var ret-code nil)
+      (ev/gather
+        (while (ev/read (proc :out) 4096 buff))
+        (set ret-code (os/proc-wait proc)))
+      (def expect-file (string dir "/" path ".expect"))
+      (def expected-out (slurp expect-file))
+      (assert (= (string/trim expected-out) (string/trim buff))
+              (string "\nfile: " fullpath "\nexpected:\n======\n" expected-out "\n======\ngot:\n======\n" buff "\n======\n")))))
+
+(do-expect-directory "test/sysir")
+
+(end-suite)

test/sysir/arrays1.janet

@@ -0,0 +1,28 @@
+(def types-asm
+  '((type-prim Double f64)
+    (type-array BigVec Double 100)))
+
+(def add-asm
+  '((link-name "add_vector")
+    (parameter-count 2)
+    # Declarations
+    (bind a BigVec)
+    (bind b BigVec)
+    (bind c BigVec)
+    (add c a b)
+    (return c)))
+
+(def sub-asm
+  '((link-name "sub_vector")
+    (parameter-count 2)
+    (bind a BigVec)
+    (bind b BigVec)
+    (bind c BigVec)
+    (subtract c a b)
+    (return c)))
+
+(def ctx (sysir/context))
+(sysir/asm ctx types-asm)
+(sysir/asm ctx add-asm)
+(sysir/asm ctx sub-asm)
+(printf "%.99j" (sysir/to-ir ctx))

test/sysir/arrays1.janet.expect

@@ -0,0 +1 @@
+@[@[(type-prim Double f64) (type-array BigVec Double 100)] @[(parameter-count 0)] @[(link-name "add_vector") (parameter-count 2) (type-bind 0 BigVec) (type-bind 1 BigVec) (type-bind 2 BigVec) (add 2 0 1) (return 2)] @[(link-name "sub_vector") (parameter-count 2) (type-bind 0 BigVec) (type-bind 1 BigVec) (type-bind 2 BigVec) (subtract 2 0 1) (return 2)]]

test/sysir/arrays2.janet

@@ -0,0 +1,22 @@
+(def ir-asm
+  '((link-name "add_vectorp")
+    (parameter-count 2)
+
+    # Types
+    (type-prim Double f64)
+    (type-array BigVec Double 100)
+    (type-pointer BigVecP BigVec)
+
+    # Declarations
+    (bind 0 BigVecP)
+    (bind 1 BigVecP)
+    (bind 2 BigVecP)
+    (add 2 0 1)
+    (return 2)))
+
+(def ctx (sysir/context))
+(sysir/asm ctx ir-asm)
+(printf "%j" (sysir/to-ir ctx))
+(sysir/scalarize ctx)
+(printf "%j" (sysir/to-ir ctx))
+(print (sysir/to-c ctx))

test/sysir/arrays2.janet.expect

@@ -0,0 +1,66 @@
+@[@[(type-prim Double f64) (type-array BigVec Double 100) (type-pointer BigVecP BigVec)] @[(link-name "add_vectorp") (parameter-count 2) (type-bind 0 BigVecP) (type-bind 1 BigVecP) (type-bind 2 BigVecP) (add 2 0 1) (return 2)]]
+@[@[(type-prim Double f64) (type-array BigVec Double 100) (type-pointer BigVecP BigVec)] @[(link-name "add_vectorp") (parameter-count 2) (type-bind 0 BigVecP) (type-bind 1 BigVecP) (type-bind 2 BigVecP) (type-bind 3 U32Index) (type-bind 5 PointerTo) (type-bind 6 PointerTo) (type-bind 7 PointerTo) (type-bind 4 Boolean) (load 3 [U32Index 0]) (label 7) (gte 4 3 [U32Index 0]) (branch 4 21) (apgetp 5 0 3) (apgetp 6 1 3) (apgetp 7 2 3) (add 7 5 6) (add 3 3 [U32Index 1]) (jump 7) (label 21) (return 2)]]
+#include <stddef.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <sys/syscall.h>
+#define _t0 void
+
+#line 6
+typedef double _t1;
+#line 7
+typedef struct { _t1 els[100]; } _t2;
+#line 8
+typedef _t2 *_t3;
+
+
+_t3 add_vectorp(_t3 _r0, _t3 _r1)
+{
+    _t3 _r2;
+    _t4 _r3;
+    _t5 _r4;
+    _t6 _r5;
+    _t6 _r6;
+    _t6 _r7;
+
+#line 6
+#line 7
+#line 8
+#line 11
+#line 12
+#line 13
+#line 14
+#line 14
+#line 14
+#line 14
+#line 14
+#line 14
+  _r3 = *(0);
+#line 14
+
+_label_0:
+#line 14
+  _r4 = _r3 > 0;
+#line 14
+  if (_r4) goto _label_1;
+#line 14
+  _r5 = &(_r0->els[_r3]);
+#line 14
+  _r6 = &(_r1->els[_r3]);
+#line 14
+  _r7 = &(_r2->els[_r3]);
+#line 14
+  _r7 = _r5 + _r6;
+#line 14
+  _r3 = _r3 + 1;
+#line 14
+  goto _label_0;
+#line 14
+
+_label_1:
+#line 15
+  return _r2;
+}

test/sysir/basic1.janet

@@ -0,0 +1,35 @@
+(def ir-asm
+  '((link-name "test_function")
+
+    # Types
+    (type-prim Int s32)
+    (type-prim Double f64)
+    (type-struct MyPair 0 1)
+    (type-pointer PInt Int)
+    (type-array DoubleArray 1 1024)
+
+    # Declarations
+    (bind 0 Int)
+    (bind 1 Int)
+    (bind 2 Int)
+    (bind 3 Double)
+    (bind bob Double)
+    (bind 5 Double)
+    (bind 6 MyPair)
+
+    # Code
+    (move 0 (Int 10))
+    (move 0 (Int 21))
+    :location
+    (add 2 1 0)
+    (move 3 (Double 1.77))
+    (call :default 3 (PInt sin) 3)
+    (cast bob 2)
+    (call :default bob (PInt test_function))
+    (add 5 bob 3)
+    (jump :location)
+    (return 5)))
+
+(def ctx (sysir/context))
+(sysir/asm ctx ir-asm)
+(print (sysir/to-c ctx))

test/sysir/basic1.janet.expect

@@ -0,0 +1,71 @@
+#include <stddef.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <stdbool.h>
+#include <stdio.h>
+#include <sys/syscall.h>
+#define _t0 void
+
+#line 5
+typedef int32_t _t1;
+#line 6
+typedef double _t2;
+#line 7
+typedef struct {
+    _t0 _f0;
+    _t1 _f1;
+} _t3;
+#line 8
+typedef _t1 *_t4;
+#line 9
+typedef struct { _t1 els[1024]; } _t5;
+
+
+_t2 test_function()
+{
+    _t1 _r0;
+    _t1 _r1;
+    _t1 _r2;
+    _t2 _r3;
+    _t2 _r4;
+    _t2 _r5;
+    _t3 _r6;
+
+#line 5
+#line 6
+#line 7
+#line 7
+#line 8
+#line 9
+#line 12
+#line 13
+#line 14
+#line 15
+#line 16
+#line 17
+#line 18
+#line 21
+  _r0 = 10;
+#line 22
+  _r0 = 21;
+
+_label_0:
+#line 24
+  _r2 = _r1 + _r0;
+#line 25
+  _r3 = 1.77;
+#line 26
+  _r3 = sin(_r3);
+#line 26
+#line 27
+  _r4 = (_t2) _r2;
+#line 28
+  _r4 = test_function();
+#line 29
+  _r5 = _r4 + _r3;
+#line 30
+  goto _label_0;
+#line 31
+  return _r5;
+}

test/sysir/basic2.janet

@@ -0,0 +1,62 @@
+### typedef struct {float x; float y; float z;} Vec3;
+###
+### Vec3 addv(Vec3 a, Vec3 b) {
+###     Vec3 ret;
+###     ret.x = a.x + b.x;
+###     ret.y = a.y + b.y;
+###     ret.z = a.z + b.z;
+###     return ret;
+### }
+
+# Use fgetp for code gen
+
+(def ir-asm
+  '((link-name "addv")
+    (parameter-count 2)
+
+    # Types
+    (type-prim Real f32)
+    (type-struct Vec3 Real Real Real)
+    (type-pointer PReal Real)
+
+    # Declarations
+    (bind position Vec3)
+    (bind velocity Vec3)
+    (bind next-position Vec3)
+    (bind dest Real)
+    (bind lhs Real)
+    (bind rhs Real)
+    (bind pdest PReal)
+    (bind plhs PReal)
+    (bind prhs PReal)
+
+    # Code
+    (fgetp pdest next-position 0)
+    (fgetp plhs position 0)
+    (fgetp prhs velocity 0)
+    (load lhs plhs)
+    (load rhs prhs)
+    (add dest lhs rhs)
+    (store pdest dest)
+
+    (fgetp pdest next-position 1)
+    (fgetp plhs position 1)
+    (fgetp prhs velocity 1)
+    (load lhs plhs)
+    (load rhs prhs)
+    (add dest lhs rhs)
+    (store pdest dest)
+
+    (fgetp pdest next-position 2)
+    (fgetp plhs position 2)
+    (fgetp prhs velocity 2)
+    (load lhs plhs)
+    (load rhs prhs)
+    (add dest lhs rhs)
+    (store pdest dest)
+
+    (return next-position)))
+
+(def ctx (sysir/context))
+(sysir/asm ctx ir-asm)
+(print (sysir/to-c ctx))

test/sysir/basic2.janet.expect

@@ -0,0 +1 @@
+nope

test/sysir/smoke.janet

@@ -0,0 +1 @@
+(print "hello")

test/sysir/smoke.janet.expect

@@ -0,0 +1 @@
+hello

tools/x64.sh

@@ -0,0 +1,21 @@
+#!/usr/bin/env bash
+
+case "$2" in
+c)
+    rm temp.bin temp.o temp.nasm
+    build/janet "$@" > temp.c
+    gcc -nostdlib temp.c -c temp.o
+    ;;
+x64)
+    rm temp.bin temp.o temp.nasm
+    build/janet "$@" > temp.nasm
+    nasm -felf64 temp.nasm -l temp.lst -o temp.o
+    ;;
+*)
+    echo "Unknown mode $2"
+    exit
+    ;;
+esac
+
+ld -o temp.bin -dynamic-linker /lib64/ld-linux-x86-64.so.2 -lc temp.o
+./temp.bin