mescc: Tinycc support: pointer arithmetic.

* module/language/c99/compiler.mes (ident->size, expr->size): New function.
  (expr->accu): Use them for ++,--,add, sub.
  (i386:type-alist): Set void size to 1.
* scaffold/tests/71-struct-array.c (test):
* scaffold/tests/76-pointer-arithmetic.c: Test it.
* make.scm (add-scaffold-test): Build it.

make.scm

@@ -155,7 +155,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
    "72-typedef-struct-def"
    "73-union"
    "74-multi-line-string"
-   "75-struct-union"))
+   "75-struct-union"
+   "76-pointer-arithmetic"))
 
 (add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
 

module/language/c99/compiler.mes

@@ -697,27 +697,46 @@
         ((post-inc (p-expr (ident ,name)))
          (let* ((type (ident->type info name))
                 (ptr (ident->pointer info name))
-                (size (if (> ptr 1) 4 1)))
+                (size (cond ((= ptr 1) (ident->size info name))
+                            ((> ptr 1) 4)
+                            (else 1))))
            (append-text info (append ((ident->accu info) name)
                                      ((ident-add info) name size)))))
 
         ((post-dec (p-expr (ident ,name)))
-         (append-text info (append ((ident->accu info) name)
+         (let* ((type (ident->type info name))
-                                   ((ident-add info) name -1))))
+                (ptr (ident->pointer info name))
+                (size (cond ((= ptr 1) (ident->size info name))
+                            ((> ptr 1) 4)
+                            (else 1))))
+           (append-text info (append ((ident->accu info) name)
+                                     ((ident-add info) name (- size))))))
 
         ((pre-inc (p-expr (ident ,name)))
-         (append-text info (append ((ident-add info) name 1)
+         (let* ((type (ident->type info name))
-                                   ((ident->accu info) name))))
+                (ptr (ident->pointer info name))
+                (size (cond ((= ptr 1) (ident->size info name))
+                            ((> ptr 1) 4)
+                            (else 1))))
+           (append-text info (append ((ident-add info) name size)
+                                     ((ident->accu info) name)))))
 
         ((pre-dec (p-expr (ident ,name)))
-         (append-text info (append ((ident-add info) name -1)
+         (let* ((type (ident->type info name))
-                                   ((ident->accu info) name))))
+                (ptr (ident->pointer info name))
+                (size (cond ((= ptr 1) (ident->size info name))
+                            ((> ptr 1) 4)
+                            (else 1))))
+           (append-text info (append ((ident-add info) name (- size))
+                                     ((ident->accu info) name)))))
 
         ((post-inc ,expr)
          (let* ((info (append ((expr->accu info) expr)))
                 (info (append-text info (wrap-as (i386:push-accu))))
                 (ptr (expr->pointer info expr))
-                (size (if (> ptr 0) 4 1))
+                (size (cond ((= ptr 1) (expr->size info expr))
+                            ((> ptr 1) 4)
+                            (else 1)))
                 (info ((expr-add info) expr size))
                 (info (append-text info (wrap-as (i386:pop-accu)))))
            info))
@@ -726,27 +745,70 @@
          (let* ((info (append ((expr->accu info) expr)))
                 (info (append-text info (wrap-as (i386:push-accu))))
                 (ptr (expr->pointer info expr))
-                (size (if (> ptr 0) 4 1))
+                (size (cond ((= ptr 1) (expr->size info expr))
+                            ((> ptr 1) 4)
+                            (else 1)))
                 (info ((expr-add info) expr (- size)))
                 (info (append-text info (wrap-as (i386:pop-accu)))))
            info))
 
         ((pre-inc ,expr)
          (let* ((ptr (expr->pointer info expr))
-                (size (if (> ptr 0) 4 1))
+                (size (cond ((= ptr 1) (expr->size info expr))
+                            ((> ptr 1) 4)
+                            (else 1)))
                 (info ((expr-add info) expr size))
                 (info (append ((expr->accu info) expr))))
            info))
 
         ((pre-dec ,expr)
          (let* ((ptr (expr->pointer info expr))
-                (size (if (> ptr 0) 4 1))
+                (size (cond ((= ptr 1) (expr->size info expr))
+                            ((> ptr 1) 4)
+                            (else 1)))
                 (info ((expr-add info) expr (- size)))
                 (info (append ((expr->accu info) expr))))
            info))
 
-        ((add ,a ,b) ((binop->accu info) a b (i386:accu+base)))
+        ((add ,a (p-expr (fixed ,value)))
-        ((sub ,a ,b) ((binop->accu info) a b (i386:accu-base)))
+         (let* ((ptr (expr->pointer info a))
+                (size (cond ((= ptr 1)  (expr->size info a))
+                            ((> ptr 1) 4)
+                            (else 1)))
+                (info ((expr->accu info) a))
+                (value (cstring->number value))
+                (value (* size value)))
+           (append-text info (wrap-as (i386:accu+value value)))))
+
+        ((add ,a ,b)
+         (let* ((ptr (expr->pointer info a))
+                (size (cond ((= ptr 1) (expr->size info a))
+                            ((> ptr 1) 4)
+                            (else 1))))
+           (if (not (= size 1))
+               (warn (format #f "TODO: pointer arithmetic: ~s\n" o))))
+         ((binop->accu info) a b (i386:accu+base)))
+
+        ((sub ,a (p-expr (fixed ,value)))
+         (let* ((ptr (expr->pointer info a))
+                (size (cond ((= ptr 1) (expr->size info a))
+                            ((> ptr 1) 4)
+                            (else 1)))
+                (info ((expr->accu info) a))
+                (value (cstring->number value))
+                (value (* size value)))
+           (stderr "sub[~s]: ~s + ~s\n" size a value)
+           (append-text info (wrap-as (i386:accu+value (- value))))))
+
+        ((sub ,a ,b)
+         (let* ((ptr (expr->pointer info a))
+                (size (cond ((= ptr 1) (expr->size info a))
+                            ((> ptr 1) 4)
+                            (else 1))))
+           (if (not (= size 1))
+               (warn (format #f "TODO: pointer arithmetic: ~s\n" o))))
+         ((binop->accu info) a b (i386:accu-base)))
+
         ((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
         ((bitwise-not ,expr)
          (let ((info ((ast->info info) expr)))
@@ -1119,7 +1181,7 @@
     ("long" . ,(make-type 'builtin 4 0 #f))
     ("long long" . ,(make-type 'builtin 8 0 #f))
     ("long long int" . ,(make-type 'builtin 8 0 #f))
-    ("void" . ,(make-type 'builtin 4 0 #f))
+    ("void" . ,(make-type 'builtin 1 0 #f))
     ;; FIXME sign
     ("unsigned char" . ,(make-type 'builtin 1 0 #f))
     ("unsigned short" . ,(make-type 'builtin 2 0 #f))
@@ -1493,6 +1555,7 @@
 (define (ident->decl info o)
   (or (assoc-ref (.locals info) o)
       (assoc-ref (.globals info) o)
+      (assoc-ref (.constants info) o)
       (begin
         (stderr "NO IDENT: ~a\n" o)
         (assoc-ref (.functions info) o))))
@@ -1501,19 +1564,33 @@
   (let ((type (ident->decl info o)))
     (cond ((global? type) (global:type type))
           ((local? type) (local:type type))
+          ((assoc-ref (.constants info) o) "int")
           (else (stderr "ident->type ~s => ~s\n" o type)
                 (car type)))))
 
 (define (ident->pointer info o)
   (let ((local (assoc-ref (.locals info) o)))
     (if local (local:pointer local)
-        (or (and=> (ident->decl info o) global:pointer) 0))))
+        (let ((global (assoc-ref (.globals info) o)))
+          (if global
+              (global:pointer (ident->decl info o))
+              0)))))
+
+(define (ident->size info o)
+  (let* ((type (ident->type info o))
+         (xtype (ast-type->type info type)))
+    (type:size xtype)))
 
 (define (expr->pointer info o)
   (pmatch o
     ((p-expr (ident ,name)) (ident->pointer info name))
     (_ (stderr "expr->pointer: unsupported: ~s\n" o) 0)))
 
+(define (expr->size info o)
+  (pmatch o
+    ((p-expr (ident ,name)) (ident->size info name))
+    (_ (stderr "expr->size: unsupported: ~s\n" o) 4)))
+
 (define (p-expr->type info o)
   (pmatch o
     ((p-expr (ident ,name)) (ident->type info name))

scaffold/tests/71-struct-array.c

@@ -58,6 +58,10 @@ test ()
   printf ("eentje: %d\n", f.bar[0]);
   printf ("tweetje: %d\n", f.bar[1]);
 
+  int *pf = &f;
+  if (*pf != 0x22) return 1;
+  if (*(pf + 1) != 0x34) return 2;
+
   struct foo *g = &f;
   printf ("punter eentje: %d\n", g->bar[0]);
   printf ("punter tweetje: %d\n", g->bar[1]);

scaffold/tests/76-pointer-arithmetic.c

@@ -0,0 +1,47 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#include "30-test.i"
+
+int
+test ()
+{
+  char *pc = 0;
+  void *pv = 0;
+  int *pi = 0;
+  char **ppc = 0;
+  void **ppv = 0;
+  int **ppi = 0;
+
+  if (++pc != 1) return 1;
+  if (++pv != 1) return 2;
+  if (++pi != 4) return 3;
+  if (++ppc != 4) return 4;
+  if (++ppv != 4) return 5;
+  if (++ppi != 4) return 6;
+  if (pc + 1 != 2) return 7;
+  if (pv + 1 != 2) return 8;
+  if (pi + 1 != 8) return 9;
+  if (ppc + 1 != 8) return 10;
+  if (ppv + 1 != 8) return 11;
+  if (ppi + 1 != 8) return 12;
+
+  return 0;
+}