mescc: Tinycc support: Support bit-fields.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 13 May 2018 15:05:28 +0000 (17:05 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 13 May 2018 15:05:28 +0000 (17:05 +0200)
* 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.

build-aux/check-mescc.sh
module/language/c99/compiler.mes
module/language/c99/info.scm
module/mes/as-i386.mes
module/mes/as-i386.scm
scaffold/tests/7q-bit-field.c [new file with mode: 0644]
stage0/x86.M1

index c2063d319f9a7967ef120cb7a2d8041793ffa79e..f2f7a160d3dd00a93aaf1eee3e529f82f63a8cca 100755 (executable)
@@ -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
index d5b94737271f7985511175c75573b57114f1c06c..0cbc52d2990db2de9a5028898496e696ae803c34 100644 (file)
       (,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))
             (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)
                             (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)
     (_ (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)
                   (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-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))
+    ((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)))))))
 
-      ((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))))
+    ((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))
+
+    ((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))))
 
     (_ (error "expr->accu*: not supported: " o))))
 
                       (<= 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))))
       ((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))))
         ((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)
index 000b364e72c8f57b96e00a439c873dfbd4b9ff13..f1a432686d634bbfc375f58060df654fef7a26c2 100644 (file)
             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
   (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?
 
 (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)
         ((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)
index 0521114fda28ffb366a149111109aa176c90a25b..f6d5ed53c4f6e4973d0c3a8db101aeca86f3e54d 100644 (file)
     ("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
   '(("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))
index 782b983d394252ff74b3fadb19afd954abd6fcb7..30a34b2d00f805d57e14e025bd67ec4373824bc6 100644 (file)
@@ -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
diff --git a/scaffold/tests/7q-bit-field.c b/scaffold/tests/7q-bit-field.c
new file mode 100644 (file)
index 0000000..24b4d39
--- /dev/null
@@ -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;
+}
index 80dadfcd165ed7081b7c969fb97bb3b8d32e807e..84a92e2e0ac4ffa4b577c692011d07d947122420 100644 (file)
@@ -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