diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh index c2063d31..f2f7a160 100755 --- 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 diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index d5b94737..0cbc52d2 100644 --- 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) diff --git a/module/language/c99/info.scm b/module/language/c99/info.scm index 000b364e..f1a43268 100644 --- a/module/language/c99/info.scm +++ b/module/language/c99/info.scm @@ -64,6 +64,13 @@ pointer:type pointer:rank + + make-bit-field + bit-field? + bit-field:type + bit-field:bit + bit-field:bits + var:name var:type @@ -155,6 +162,13 @@ (type pointer:type) (rank pointer:rank)) +(define-immutable-record-type + (make-bit-field type bit bits) + bit-field? + (type bit-field:type) + (bit bit-field:bit) + (bits bit-field:bits)) + (define-immutable-record-type (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) diff --git a/module/mes/as-i386.mes b/module/mes/as-i386.mes index 0521114f..f6d5ed53 100644 --- 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)) diff --git a/module/mes/as-i386.scm b/module/mes/as-i386.scm index 782b983d..30a34b2d 100644 --- 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 diff --git a/scaffold/tests/7q-bit-field.c b/scaffold/tests/7q-bit-field.c new file mode 100644 index 00000000..24b4d394 --- /dev/null +++ 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 + * + * 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 . + */ + +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; +} diff --git a/stage0/x86.M1 b/stage0/x86.M1 index 80dadfcd..84a92e2e 100644 --- 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