mescc: Tinycc support: pointer arithmetic.
[mes.git] / module / language / c99 / compiler.mes
index 979f44fdb2ece63da24e821bd717f96f666cc066..7ba89c921b86c1bd3f936291387f61f1cc274bb8 100644 (file)
         ((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)
-                                   ((ident-add info) name -1))))
+         (let* ((type (ident->type 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->accu info) name)
+                                     ((ident-add info) name (- size))))))
 
         ((pre-inc (p-expr (ident ,name)))
-         (append-text info (append ((ident-add info) name 1)
-                                   ((ident->accu info) name))))
+         (let* ((type (ident->type 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)
-                                   ((ident->accu info) name))))
+         (let* ((type (ident->type 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))
          (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)))
-        ((sub ,a ,b) ((binop->accu info) a b (i386:accu-base)))
+        ((add ,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)))
+           (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)))
     ("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))
 (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))))
   (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))