diff --git a/examples/sysir/drawing.janet b/examples/sysir/drawing.janet new file mode 100644 index 00000000..ed00db9f --- /dev/null +++ b/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 ") +(dumpc) +#(dumpx64) diff --git a/examples/sysir/frontend.janet b/examples/sysir/frontend.janet index 79e896b5..0aece872 100644 --- a/examples/sysir/frontend.janet +++ b/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))]) diff --git a/examples/sysir/run_drawing.sh b/examples/sysir/run_drawing.sh new file mode 100755 index 00000000..ff535d27 --- /dev/null +++ b/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 diff --git a/examples/sysir/samples.janet b/examples/sysir/samples.janet index 7dd4e8fe..6b62bfc1 100644 --- a/examples/sysir/samples.janet +++ b/examples/sysir/samples.janet @@ -67,6 +67,6 @@ #### -(dump) +#(dump) #(dumpc) -#(dumpx64) +(dumpx64) diff --git a/src/core/sysir.c b/src/core/sysir.c index 47fbad18..4bd9c905 100644 --- a/src/core/sysir.c +++ b/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;