mescc: Tinycc support: Support bit-fields.

* module/language/c99/compiler.mes (struct->fields): Support bit-fields. (ast->type): (field-field): (field-offset): (expr->accu*): (expr->accu): (struct-field): (->size): * module/language/c99/info.scm (<bit-field>): New type. * stage0/x86.M1 (and____$i32,%eax, and____(%edx),%eax, mov____(%edx),%eax, or____(%edx),%eax): New macro. * module/mes/as-i386.mes (i386:base-mem->accu): Use it. (i386:accu-and, i386:accu-and-base-mem, i386:accu-or-base-mem): New function. * module/mes/as-i386.scm: Export them. * scaffold/tests/7q-bit-field.c: Test it. * build-aux/check-mescc.sh (tests): Run it.
2018-05-13 17:05:28 +02:00 · 2018-05-13 17:05:28 +02:00 · 0f87473105
parent dae4a30417
commit 0f87473105
7 changed files with 210 additions and 74 deletions
--- a/build-aux/check-mescc.sh
+++ b/build-aux/check-mescc.sh
@ -114,6 +114,7 @@ t
 7n-struct-struct-array
 7o-struct-pre-post
 7p-struct-cast
+7q-bit-field
 80-setjmp
 81-qsort
 82-define
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@ -184,6 +184,7 @@
      (,t (guard (type? t)) t)
      (,p (guard (pointer? p)) p)
      (,a (guard (c-array? a)) a)
+      (,b (guard (bit-field? b)) b)

      ((char ,value) (get-type "char" info))
      ((enum-ref . _) (get-type "int" info))
@ -362,6 +363,7 @@
            (cond ((equal? (car f) field) f)
                  ((and (memq (car f) '(struct union)) (type? (cdr f))
                        (find (lambda (x) (equal? (car x) field)) (struct->fields (cdr f)))))
+                  ((eq? (car f) 'bits) (assoc field (cdr f)))
                  (else (loop (cdr fields)))))))))

 (define (field-offset info struct field)
@ -383,6 +385,7 @@
                            (let ((fields (struct->fields (cdr f))))
                              (and (find (lambda (x) (equal? (car x) field)) fields)
                                   offset))))
+                      ((and (eq? (car f) 'bits) (assoc-ref (cdr f) field)) offset)
                      (else (loop (cdr fields) (+ offset (field:size f)))))))))))

 (define (field-pointer info struct field)
@ -409,7 +412,8 @@
    (_ (guard (and (type? o) (eq? (type:type o) 'union)))
       (append-map struct->fields (type:description o)))
    ((struct . ,type) (list (car (type:description type))))
-    ((struct . ,type) (list (car (type:description type))))
+    ((union . ,type) (list (car (type:description type))))
+    ((bits . ,bits) bits)
    (_ (list o))))

 (define (struct->init-fields o)
@ -832,77 +836,77 @@
                  (info (expr->accu* a info)))
             (append-text info (wrap-as (i386:accu+base)))))))

-      ((sub ,a ,b)
-       (let* ((rank (expr->rank info a))
-              (rank-b (expr->rank info b))
-              (type (ast->basic-type a info))
-              (struct? (structured-type? type))
-              (size (->size type))
-              (size  (cond ((= rank 1) size)
-                           ((> rank 1) 4)
-                           ((and struct? (= rank 2)) 4)
-                           (else 1))))
-         (if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
-             (let ((info ((binop->accu* info) a b (i386:accu-base))))
-               (if (and (not (= rank-b 2)) (not (= rank-b 1))) info
-                   (append-text info (wrap-as (append (i386:value->base size)
-                                                      (i386:accu/base))))))
-             (let* ((info (expr->accu* b info))
-                    (info (append-text info (wrap-as (append (i386:value->base size)
-                                                             (i386:accu*base)
-                                                             (i386:accu->base)))))
-                    (info (expr->accu* a info)))
-               (append-text info (wrap-as (i386:accu-base)))))))
+    ((sub ,a ,b)
+     (let* ((rank (expr->rank info a))
+            (rank-b (expr->rank info b))
+            (type (ast->basic-type a info))
+            (struct? (structured-type? type))
+            (size (->size type))
+            (size  (cond ((= rank 1) size)
+                         ((> rank 1) 4)
+                         ((and struct? (= rank 2)) 4)
+                         (else 1))))
+       (if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
+           (let ((info ((binop->accu* info) a b (i386:accu-base))))
+             (if (and (not (= rank-b 2)) (not (= rank-b 1))) info
+                 (append-text info (wrap-as (append (i386:value->base size)
+                                                    (i386:accu/base))))))
+           (let* ((info (expr->accu* b info))
+                  (info (append-text info (wrap-as (append (i386:value->base size)
+                                                           (i386:accu*base)
+                                                           (i386:accu->base)))))
+                  (info (expr->accu* a info)))
+             (append-text info (wrap-as (i386:accu-base)))))))

-      ((pre-dec ,expr)
-         (let* ((rank (expr->rank info expr))
-                (size (cond ((= rank 1) (ast-type->size info expr))
-                            ((> rank 1) 4)
-                            (else 1)))
-                (info ((expr-add info) expr (- size)))
-                (info (append (expr->accu* expr info))))
-           info))
+    ((pre-dec ,expr)
+     (let* ((rank (expr->rank info expr))
+            (size (cond ((= rank 1) (ast-type->size info expr))
+                        ((> rank 1) 4)
+                        (else 1)))
+            (info ((expr-add info) expr (- size)))
+            (info (append (expr->accu* expr info))))
+       info))

-      ((pre-inc ,expr)
-         (let* ((rank (expr->rank info expr))
-                (size (cond ((= rank 1) (ast-type->size info expr))
-                            ((> rank 1) 4)
-                            (else 1)))
-                (info ((expr-add info) expr size))
-                (info (append (expr->accu* expr info))))
-           info))
+    ((pre-inc ,expr)
+     (let* ((rank (expr->rank info expr))
+            (size (cond ((= rank 1) (ast-type->size info expr))
+                        ((> rank 1) 4)
+                        (else 1)))
+            (info ((expr-add info) expr size))
+            (info (append (expr->accu* expr info))))
+       info))

-      ((post-dec ,expr)
-       (let* ((info (expr->accu* expr info))
-              (info (append-text info (wrap-as (i386:push-accu))))
-              (post (clone info #:text '()))
-              (post (append-text post (ast->comment o)))
-              (post (append-text post (wrap-as (i386:pop-base))))
-              (post (append-text post (wrap-as (i386:push-accu))))
-              (post (append-text post (wrap-as (i386:base->accu))))
-              (rank (expr->rank post expr))
-              (size (cond ((= rank 1) (ast-type->size post expr))
-                          ((> rank 1) 4)
-                          (else 1)))
-              (post ((expr-add post) expr (- size)))
-              (post (append-text post (wrap-as (i386:pop-accu)))))
-         (clone info #:post (.text post))))
+    ((post-dec ,expr)
+     (let* ((info (expr->accu* expr info))
+            (info (append-text info (wrap-as (i386:push-accu))))
+            (post (clone info #:text '()))
+            (post (append-text post (ast->comment o)))
+            (post (append-text post (wrap-as (i386:pop-base))))
+            (post (append-text post (wrap-as (i386:push-accu))))
+            (post (append-text post (wrap-as (i386:base->accu))))
+            (rank (expr->rank post expr))
+            (size (cond ((= rank 1) (ast-type->size post expr))
+                        ((> rank 1) 4)
+                        (else 1)))
+            (post ((expr-add post) expr (- size)))
+            (post (append-text post (wrap-as (i386:pop-accu)))))
+       (clone info #:post (.text post))))

-      ((post-inc ,expr)
-       (let* ((info (expr->accu* expr info))
-              (info (append-text info (wrap-as (i386:push-accu))))
-              (post (clone info #:text '()))
-              (post (append-text post (ast->comment o)))
-              (post (append-text post (wrap-as (i386:pop-base))))
-              (post (append-text post (wrap-as (i386:push-accu))))
-              (post (append-text post (wrap-as (i386:base->accu))))
-              (rank (expr->rank post expr))
-              (size (cond ((= rank 1) (ast-type->size post expr))
-                          ((> rank 1) 4)
-                          (else 1)))
-              (post ((expr-add post) expr size))
-              (post (append-text post (wrap-as (i386:pop-accu)))))
-         (clone info #:post (.text post))))
+    ((post-inc ,expr)
+     (let* ((info (expr->accu* expr info))
+            (info (append-text info (wrap-as (i386:push-accu))))
+            (post (clone info #:text '()))
+            (post (append-text post (ast->comment o)))
+            (post (append-text post (wrap-as (i386:pop-base))))
+            (post (append-text post (wrap-as (i386:push-accu))))
+            (post (append-text post (wrap-as (i386:base->accu))))
+            (rank (expr->rank post expr))
+            (size (cond ((= rank 1) (ast-type->size post expr))
+                        ((> rank 1) 4)
+                        (else 1)))
+            (post ((expr-add post) expr size))
+            (post (append-text post (wrap-as (i386:pop-accu)))))
+       (clone info #:post (.text post))))

    (_ (error "expr->accu*: not supported: " o))))

@ -1301,7 +1305,27 @@
                      (<= size-b 4)) (append-text info ((accu->ident info) name))
                      (let ((info (expr->base* a info)))
                        (accu->base-mem*n info size))))
-             (_ (let ((info (expr->base* a info)))
+             (_ (let* ((info (expr->base* a info))
+                       (info (if (not (bit-field? type)) info
+                                 (let* ((bit (bit-field:bit type))
+                                        (bits (bit-field:bits type))
+                                        (set-mask (- (ash bits 1) 1))
+                                        (shifted-set-mask (ash set-mask bit))
+                                        (clear-mask (logxor shifted-set-mask #b11111111111111111111111111111111))
+                                        (info (append-text info (wrap-as (i386:push-base))))
+                                        (info (append-text info (wrap-as (i386:push-accu))))
+
+                                        (info (append-text info (wrap-as (i386:base-mem->accu))))
+                                        (info (append-text info (wrap-as (i386:accu-and clear-mask))))
+                                        (info (append-text info (wrap-as (i386:accu->base))))
+
+                                        (info (append-text info (wrap-as (i386:pop-accu))))
+                                        (info (append-text info (wrap-as (i386:accu-and set-mask))))
+                                        (info (append-text info (wrap-as (i386:accu-shl bit))))
+                                        (info (append-text info (wrap-as (i386:accu-or-base))))
+
+                                        (info (append-text info (wrap-as (i386:pop-base)))))
+                                   info))))
                  (accu->base-mem*n info (min size (max 4 size-b)))))))) ;; FIXME: long long = int

        (_ (error "expr->accu: not supported: " o))))
@ -1544,6 +1568,17 @@
      ((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
       (let ((fields (append-map (struct-field info) fields)))
         (list (cons 'union (make-type 'union (apply + (map field:size fields)) fields)))))
+      ((comp-decl (decl-spec-list (type-spec ,type)) (comp-declr-list (comp-declr (bit-field (ident ,name) (p-expr (fixed ,bits)))) . ,fields))
+       (let ((type (ast->type type info)))
+         (list (cons 'bits (let loop ((o `((comp-declr (bit-field (ident ,name) (p-expr (fixed ,bits)))) . ,fields)) (bit 0))
+                             (if (null? o) '()
+                                 (let ((field (car o)))
+                                   (pmatch field
+                                     ((comp-declr (bit-field (ident ,name) (p-expr (fixed ,bits))))
+                                      (let ((bits (cstring->number bits)))
+                                        (cons (cons name (make-bit-field type bit bits))
+                                              (loop (cdr o) (+ bit bits)))))
+                                     (_ (error "struct-field: not supported:" field o))))))))))
      ((comp-decl (decl-spec-list ,type) (comp-declr-list . ,decls))
       (append-map (lambda (o)
                     ((struct-field info) `(comp-decl (decl-spec-list ,type) (comp-declr-list ,o))))
@ -1560,6 +1595,8 @@
        ((c-array? o) (* (c-array:count o) ((compose ->size c-array:type) o)))
        ((local? o) ((compose ->size local:type) o))
        ((global? o) ((compose ->size global:type) o))
+        ((bit-field? o) ((compose ->size bit-field:type) o))
+        ((and (pair? o) (pair? (car o)) (bit-field? (cdar o))) ((compose ->size cdar) o))
        ;; FIXME
        ;; (#t
        ;;  (stderr "o=~s\n" o)
--- a/module/language/c99/info.scm
+++ b/module/language/c99/info.scm
@ -64,6 +64,13 @@
            pointer:type
            pointer:rank

+            <bit-field>
+            make-bit-field
+            bit-field?
+            bit-field:type
+            bit-field:bit
+            bit-field:bits
+
            <var>
            var:name
            var:type
@ -155,6 +162,13 @@
  (type pointer:type)
  (rank pointer:rank))

+(define-immutable-record-type <bit-field>
+  (make-bit-field type bit bits)
+  bit-field?
+  (type bit-field:type)
+  (bit bit-field:bit)
+  (bits bit-field:bits))
+
 (define-immutable-record-type <var>
  (make-var name type function id value)
  var?
@ -211,6 +225,7 @@

 (define (->type o)
  (cond ((type? o) o)
+        ((bit-field? o) o)
        ((pointer? o) (pointer:type o))
        ((c-array? o) (c-array:type o))
        ((and (pair? o) (eq? (car o) 'tag)) o)
@ -226,6 +241,7 @@
        ((c-array? o) (1+ ((compose ->rank c-array:type) o)))
        ((local? o) ((compose ->rank local:type) o))
        ((global? o) ((compose ->rank global:type) o))
+        ((bit-field? o) 0)
        ;; FIXME
        (#t
         (format (current-error-port) "->rank: not a type: ~s\n" o)
--- a/module/mes/as-i386.mes
+++ b/module/mes/as-i386.mes
@ -282,7 +282,16 @@
    ("shr____%cl,%eax")))               ; shr    %cl,%eax

 (define (i386:accu-and-base)
-  '(("and____%edx,%eax")))              ; and    %edx,%eax
+  '(("and____%edx,%eax")))
+
+(define (i386:accu-and v)
+  `(("and____$i32,%eax" (#:immediate ,v))))
+
+(define (i386:accu-and-base-mem)
+  '(("and____(%edx),%eax")))
+
+(define (i386:accu-or-base-mem)
+  '(("or_____(%edx),%eax")))

 (define (i386:accu-not)
  '(("not____%eax")))                   ; not %eax
@ -357,14 +366,13 @@
  '(("movzbl_(%edx),%edx")))            ; movzbl (%edx),%edx

 (define (i386:base-mem->accu)
-  '(("add___%edx,%eax")                 ; add    %edx,%eax
-    ("mov____(%eax),%eax")))            ; mov    (%eax),%eax
+  '(("mov____(%edx),%eax")))

 (define (i386:mem->accu)
-  '(("mov____(%eax),%eax")))            ; mov    (%eax),%eax
+  '(("mov____(%eax),%eax")))

 (define (i386:mem->base)
-  '(("mov____(%edx),%edx")))            ; mov    (%edx),%edx
+  '(("mov____(%edx),%edx")))

 (define (i386:mem+n->accu n)
  `(,(if (< (abs n) #x80) `("mov____0x8(%eax),%eax" (#:immediate1 ,n))
--- a/module/mes/as-i386.scm
+++ b/module/mes/as-i386.scm
@ -48,7 +48,9 @@
            i386:byte-accu->local+n
            i386:word-accu->local+n
            i386:accu->local+n
+            i386:accu-and
            i386:accu-and-base
+            i386:accu-and-base-mem
            i386:accu-base
            i386:accu-cmp-value
            i386:accu-mem-add
@ -56,6 +58,7 @@
            i386:accu-negate
            i386:accu-not
            i386:accu-or-base
+            i386:accu-or-base-mem
            i386:accu-shl
            i386:accu-test
            i386:accu-xor-base
--- a/scaffold/tests/7q-bit-field.c
+++ b/scaffold/tests/7q-bit-field.c
@ -0,0 +1,67 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) 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/>.
+ */
+
+struct bits
+{
+  int
+  one: 1,
+    two : 1,
+    four: 1,
+    eightsixteen: 2;
+};
+
+union foo
+{
+  struct bits b;
+  int i;
+};
+
+int
+main ()
+{
+  union foo f;
+  f.b.one = 1;
+  if (f.i != 1)
+    return 1;
+  f.b.two = 1;
+  if (f.i != 3)
+    return 2;
+  f.b.four = 1;
+  if (f.i != 7)
+    return 3;
+  f.b.eightsixteen = 3;
+  if (f.i != 31)
+    return 4;
+
+  f.i = 1;
+  f.b.one = 0;
+  if (f.i)
+    return 5;
+  f.i = 24;
+  f.b.eightsixteen = 0;
+  if (f.i)
+    return 6;
+  f.i = 8;
+  f.b.eightsixteen = 2;
+  if (f.i != 16)
+    return 7;
+
+  return 0;
+}
--- a/stage0/x86.M1
+++ b/stage0/x86.M1
@ -37,7 +37,9 @@ DEFINE add____%eax,%eax 01c0
 DEFINE add____%ebp,%eax 01e8
 DEFINE add____%edx,%eax 01d0
 DEFINE add____%edx,%eax 01d0
+DEFINE and____$i32,%eax 25
 DEFINE and____%edx,%eax 21d0
+DEFINE and____(%edx),%eax 2302
 DEFINE call32 e8
 DEFINE call___*%eax ffd0
 DEFINE cmp____$0x32,%eax 3d
@ -116,6 +118,7 @@ DEFINE mov____%edx,0x8(%ebp) 8955
 DEFINE mov____%esp,%ebp 89e5
 DEFINE mov____(%eax),%eax 8b00
 DEFINE mov____(%eax),%ecx 8b08
+DEFINE mov____(%edx),%eax 8b02
 DEFINE mov____(%edx),%ecx 8b0a
 DEFINE mov____(%edx),%edx 8b12
 DEFINE mov____0x32(%eax),%eax 8b80
@ -157,6 +160,7 @@ DEFINE mul____%edx f7e2
 DEFINE nop 90
 DEFINE not____%eax f7d0
 DEFINE or_____%edx,%eax 09d0
+DEFINE or_____(%edx),%eax 0b02
 DEFINE pop____%eax 58
 DEFINE pop____%edx 5a
 DEFINE push___$i32 68