diff --git a/examples/sysir/drawing.janet b/examples/sysir/drawing.janet index ed00db9f..ed4c3052 100644 --- a/examples/sysir/drawing.janet +++ b/examples/sysir/drawing.janet @@ -5,10 +5,11 @@ (use ./frontend) (defpointer p32 uint) +(defpointer cursor p32) (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]) +(defn-external malloc:pointer [x:uint]) +(defn-external free:void [m:pointer]) # assume 128x128 32 bit color image # Size : 128 * 128 * 4 + align(14 + 40, 4) = 65592 @@ -16,7 +17,6 @@ (setdyn :verbose true) - (defsys write_32:void [x:uint] (write 1 (address x) 4) (return)) @@ -25,6 +25,12 @@ (write 1 (address x) 2) (return)) +(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 write_header:void [w:uint h:uint] (write 1 "BM" 2) (def size:uint (+ 56 (* w h 4))) @@ -39,8 +45,8 @@ (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 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 @@ -50,7 +56,7 @@ (def red:uint 0xFFFF0000) (def blue:uint 0xFF0000FF) (def size:uint (* w h 4)) - (def mem:p32 (malloc size)) + (def mem:pointer (malloc size)) (store mem (the uint 10)) (var y:uint 0) (while (< y h) diff --git a/examples/sysir/frontend.janet b/examples/sysir/frontend.janet index 0aece872..4403a88d 100644 --- a/examples/sysir/frontend.janet +++ b/examples/sysir/frontend.janet @@ -12,7 +12,6 @@ (def slot-types @{}) (def functions @{}) (def type-fields @{}) -(def pointer-derefs @{}) (defn get-slot [&opt new-name] @@ -71,8 +70,9 @@ (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) - (array/push into ~(type-pointer pointer byte)) + (array/push into ~(type-pointer pointer uint)) (make-type 'pointer) (sysir/asm ctx into) ctx) @@ -139,6 +139,18 @@ '> (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) + # Type hinting 'the (do @@ -198,8 +210,8 @@ (do (assert (= 1 (length args))) (def [thing] args) - (def [name tp] (type-extract thing 'pointer)) - (def result (visit1 thing into false tp)) + # (def [name tp] (type-extract thing 'pointer)) + (def result (visit1 thing into false)) (def slot (get-slot)) (def ptype (or type-hint 'char)) (array/push into ~(bind ,slot ,ptype)) @@ -210,8 +222,8 @@ (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 [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) diff --git a/src/core/sysir.c b/src/core/sysir.c index 4bd9c905..d7149d75 100644 --- a/src/core/sysir.c +++ b/src/core/sysir.c @@ -897,8 +897,9 @@ static void rcheck_pointer_equals(JanetSysIR *sysir, uint32_t preg, uint32_t elr janet_panicf("type failure in %p, expected pointer for array, got %p", sysir->error_ctx, tname(sysir, t1)); } uint32_t tp = linkage->type_defs[t1].pointer.type; + JanetPrim tpprim = linkage->type_defs[tp].prim; uint32_t t2 = janet_sys_optype(sysir, elreg); - if (t2 != tp) { + if (t2 != tp && tpprim != JANET_PRIM_VOID) { /* void pointer is compatible with everything TODO - can we get rid of this? */ janet_panicf("type failure in %p, %p is not compatible with a pointer to %p", sysir->error_ctx, tname(sysir, t2), @@ -1351,7 +1352,12 @@ static const char *c_prim_names[] = { "float", "double", "void *", - "bool" + "bool", + "!!!struct", + "!!!union", + "!!!array", + "void", + "!!!unknown" }; /* Print a C constant */