More working on pointer arithmetic.

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 malloc:pointer [x:uint])
-(defn-external free:void [m:p32])
+(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 4096) # pixels per meter - horizontal resolution
-  (write_32 8192) # pixels per meter - vertical 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)

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 [name tp] (type-extract thing 'pointer))
-            (def result (visit1 thing into false tp))
+            (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 [name tp] (type-extract dest 'pointer))
-            (def dest-r (visit1 dest into false tp))
+            (def dest-r (visit1 dest into false))
             (def value-r (visit1 value into false))
             (array/push into ~(store ,dest-r ,value-r))
             value-r)

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 */