andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Jan Nieuwenhuizen 2018-05-13 17:05:28 +02:00
parent dae4a30417
commit 0f87473105
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
7 changed files with 210 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
build-aux/check-mescc.sh
View File

@ -114,6 +114,7 @@ t
7n-struct-struct-array 7n-struct-struct-array
7o-struct-pre-post 7o-struct-pre-post
7p-struct-cast 7p-struct-cast
7q-bit-field
80-setjmp 80-setjmp
81-qsort 81-qsort
82-define 82-define

175
module/language/c99/compiler.mes
View File

@ -184,6 +184,7 @@
(,t (guard (type? t)) t) (,t (guard (type? t)) t)
(,p (guard (pointer? p)) p) (,p (guard (pointer? p)) p)
(,a (guard (c-array? a)) a) (,a (guard (c-array? a)) a)
(,b (guard (bit-field? b)) b)
((char ,value) (get-type "char" info)) ((char ,value) (get-type "char" info))
((enum-ref . _) (get-type "int" info)) ((enum-ref . _) (get-type "int" info))
@ -362,6 +363,7 @@
(cond ((equal? (car f) field) f) (cond ((equal? (car f) field) f)
((and (memq (car f) '(struct union)) (type? (cdr f)) ((and (memq (car f) '(struct union)) (type? (cdr f))
(find (lambda (x) (equal? (car x) field)) (struct->fields (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))))))))) (else (loop (cdr fields)))))))))
(define (field-offset info struct field) (define (field-offset info struct field)
@ -383,6 +385,7 @@
(let ((fields (struct->fields (cdr f)))) (let ((fields (struct->fields (cdr f))))
(and (find (lambda (x) (equal? (car x) field)) fields) (and (find (lambda (x) (equal? (car x) field)) fields)
offset)))) offset))))
((and (eq? (car f) 'bits) (assoc-ref (cdr f) field)) offset)
(else (loop (cdr fields) (+ offset (field:size f))))))))))) (else (loop (cdr fields) (+ offset (field:size f)))))))))))
(define (field-pointer info struct field) (define (field-pointer info struct field)
@ -409,7 +412,8 @@
(_ (guard (and (type? o) (eq? (type:type o) 'union))) (_ (guard (and (type? o) (eq? (type:type o) 'union)))
(append-map struct->fields (type:description o))) (append-map struct->fields (type:description o)))
((struct . ,type) (list (car (type:description type)))) ((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)))) (_ (list o))))
(define (struct->init-fields o) (define (struct->init-fields o)
@ -832,77 +836,77 @@
(info (expr->accu* a info))) (info (expr->accu* a info)))
(append-text info (wrap-as (i386:accu+base))))))) (append-text info (wrap-as (i386:accu+base)))))))
((sub ,a ,b) ((sub ,a ,b)
(let* ((rank (expr->rank info a)) (let* ((rank (expr->rank info a))
(rank-b (expr->rank info b)) (rank-b (expr->rank info b))
(type (ast->basic-type a info)) (type (ast->basic-type a info))
(struct? (structured-type? type)) (struct? (structured-type? type))
(size (->size type)) (size (->size type))
(size (cond ((= rank 1) size) (size (cond ((= rank 1) size)
((> rank 1) 4) ((> rank 1) 4)
((and struct? (= rank 2)) 4) ((and struct? (= rank 2)) 4)
(else 1)))) (else 1))))
(if (or (= size 1) (or (= rank-b 2) (= rank-b 1))) (if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
(let ((info ((binop->accu* info) a b (i386:accu-base)))) (let ((info ((binop->accu* info) a b (i386:accu-base))))
(if (and (not (= rank-b 2)) (not (= rank-b 1))) info (if (and (not (= rank-b 2)) (not (= rank-b 1))) info
(append-text info (wrap-as (append (i386:value->base size) (append-text info (wrap-as (append (i386:value->base size)
(i386:accu/base)))))) (i386:accu/base))))))
(let* ((info (expr->accu* b info)) (let* ((info (expr->accu* b info))
(info (append-text info (wrap-as (append (i386:value->base size) (info (append-text info (wrap-as (append (i386:value->base size)
(i386:accu*base) (i386:accu*base)
(i386:accu->base))))) (i386:accu->base)))))
(info (expr->accu* a info))) (info (expr->accu* a info)))
(append-text info (wrap-as (i386:accu-base))))))) (append-text info (wrap-as (i386:accu-base)))))))
((pre-dec ,expr) ((pre-dec ,expr)
(let* ((rank (expr->rank info expr)) (let* ((rank (expr->rank info expr))
(size (cond ((= rank 1) (ast-type->size info expr)) (size (cond ((= rank 1) (ast-type->size info expr))
((> rank 1) 4) ((> rank 1) 4)
(else 1))) (else 1)))
(info ((expr-add info) expr (- size))) (info ((expr-add info) expr (- size)))
(info (append (expr->accu* expr info)))) (info (append (expr->accu* expr info))))
info)) info))
((pre-inc ,expr) ((pre-inc ,expr)
(let* ((rank (expr->rank info expr)) (let* ((rank (expr->rank info expr))
(size (cond ((= rank 1) (ast-type->size info expr)) (size (cond ((= rank 1) (ast-type->size info expr))
((> rank 1) 4) ((> rank 1) 4)
(else 1))) (else 1)))
(info ((expr-add info) expr size)) (info ((expr-add info) expr size))
(info (append (expr->accu* expr info)))) (info (append (expr->accu* expr info))))
info)) info))
((post-dec ,expr) ((post-dec ,expr)
(let* ((info (expr->accu* expr info)) (let* ((info (expr->accu* expr info))
(info (append-text info (wrap-as (i386:push-accu)))) (info (append-text info (wrap-as (i386:push-accu))))
(post (clone info #:text '())) (post (clone info #:text '()))
(post (append-text post (ast->comment o))) (post (append-text post (ast->comment o)))
(post (append-text post (wrap-as (i386:pop-base)))) (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:push-accu))))
(post (append-text post (wrap-as (i386:base->accu)))) (post (append-text post (wrap-as (i386:base->accu))))
(rank (expr->rank post expr)) (rank (expr->rank post expr))
(size (cond ((= rank 1) (ast-type->size post expr)) (size (cond ((= rank 1) (ast-type->size post expr))
((> rank 1) 4) ((> rank 1) 4)
(else 1))) (else 1)))
(post ((expr-add post) expr (- size))) (post ((expr-add post) expr (- size)))
(post (append-text post (wrap-as (i386:pop-accu))))) (post (append-text post (wrap-as (i386:pop-accu)))))
(clone info #:post (.text post)))) (clone info #:post (.text post))))
((post-inc ,expr) ((post-inc ,expr)
(let* ((info (expr->accu* expr info)) (let* ((info (expr->accu* expr info))
(info (append-text info (wrap-as (i386:push-accu)))) (info (append-text info (wrap-as (i386:push-accu))))
(post (clone info #:text '())) (post (clone info #:text '()))
(post (append-text post (ast->comment o))) (post (append-text post (ast->comment o)))
(post (append-text post (wrap-as (i386:pop-base)))) (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:push-accu))))
(post (append-text post (wrap-as (i386:base->accu)))) (post (append-text post (wrap-as (i386:base->accu))))
(rank (expr->rank post expr)) (rank (expr->rank post expr))
(size (cond ((= rank 1) (ast-type->size post expr)) (size (cond ((= rank 1) (ast-type->size post expr))
((> rank 1) 4) ((> rank 1) 4)
(else 1))) (else 1)))
(post ((expr-add post) expr size)) (post ((expr-add post) expr size))
(post (append-text post (wrap-as (i386:pop-accu))))) (post (append-text post (wrap-as (i386:pop-accu)))))
(clone info #:post (.text post)))) (clone info #:post (.text post))))
(_ (error "expr->accu*: not supported: " o)))) (_ (error "expr->accu*: not supported: " o))))
@ -1301,7 +1305,27 @@
(<= size-b 4)) (append-text info ((accu->ident info) name)) (<= size-b 4)) (append-text info ((accu->ident info) name))
(let ((info (expr->base* a info))) (let ((info (expr->base* a info)))
(accu->base-mem*n info size)))) (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 (accu->base-mem*n info (min size (max 4 size-b)))))))) ;; FIXME: long long = int
(_ (error "expr->accu: not supported: " o)))) (_ (error "expr->accu: not supported: " o))))
@ -1544,6 +1568,17 @@
((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields))))) ((comp-decl (decl-spec-list (type-spec (union-def (field-list . ,fields)))))
(let ((fields (append-map (struct-field info) fields))) (let ((fields (append-map (struct-field info) fields)))
(list (cons 'union (make-type 'union (apply + (map field:size fields)) 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)) ((comp-decl (decl-spec-list ,type) (comp-declr-list . ,decls))
(append-map (lambda (o) (append-map (lambda (o)
((struct-field info) `(comp-decl (decl-spec-list ,type) (comp-declr-list ,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))) ((c-array? o) (* (c-array:count o) ((compose ->size c-array:type) o)))
((local? o) ((compose ->size local:type) o)) ((local? o) ((compose ->size local:type) o))
((global? o) ((compose ->size global: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 ;; FIXME
;; (#t ;; (#t
;; (stderr "o=~s\n" o) ;; (stderr "o=~s\n" o)

16
module/language/c99/info.scm
View File

@ -64,6 +64,13 @@
pointer:type pointer:type
pointer:rank pointer:rank
<bit-field>
make-bit-field
bit-field?
bit-field:type
bit-field:bit
bit-field:bits
<var> <var>
var:name var:name
var:type var:type
@ -155,6 +162,13 @@
(type pointer:type) (type pointer:type)
(rank pointer:rank)) (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> (define-immutable-record-type <var>
(make-var name type function id value) (make-var name type function id value)
var? var?
@ -211,6 +225,7 @@
(define (->type o) (define (->type o)
(cond ((type? o) o) (cond ((type? o) o)
((bit-field? o) o)
((pointer? o) (pointer:type o)) ((pointer? o) (pointer:type o))
((c-array? o) (c-array:type o)) ((c-array? o) (c-array:type o))
((and (pair? o) (eq? (car o) 'tag)) o) ((and (pair? o) (eq? (car o) 'tag)) o)
@ -226,6 +241,7 @@
((c-array? o) (1+ ((compose ->rank c-array:type) o))) ((c-array? o) (1+ ((compose ->rank c-array:type) o)))
((local? o) ((compose ->rank local:type) o)) ((local? o) ((compose ->rank local:type) o))
((global? o) ((compose ->rank global:type) o)) ((global? o) ((compose ->rank global:type) o))
((bit-field? o) 0)
;; FIXME ;; FIXME
(#t (#t
(format (current-error-port) "->rank: not a type: ~s\n" o) (format (current-error-port) "->rank: not a type: ~s\n" o)

18
module/mes/as-i386.mes
View File

@ -282,7 +282,16 @@
("shr____%cl,%eax"))) ; shr %cl,%eax ("shr____%cl,%eax"))) ; shr %cl,%eax
(define (i386:accu-and-base) (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) (define (i386:accu-not)
'(("not____%eax"))) ; not %eax '(("not____%eax"))) ; not %eax
@ -357,14 +366,13 @@
'(("movzbl_(%edx),%edx"))) ; movzbl (%edx),%edx '(("movzbl_(%edx),%edx"))) ; movzbl (%edx),%edx
(define (i386:base-mem->accu) (define (i386:base-mem->accu)
'(("add___%edx,%eax") ; add %edx,%eax '(("mov____(%edx),%eax")))
("mov____(%eax),%eax"))) ; mov (%eax),%eax
(define (i386:mem->accu) (define (i386:mem->accu)
'(("mov____(%eax),%eax"))) ; mov (%eax),%eax '(("mov____(%eax),%eax")))
(define (i386:mem->base) (define (i386:mem->base)
'(("mov____(%edx),%edx"))) ; mov (%edx),%edx '(("mov____(%edx),%edx")))
(define (i386:mem+n->accu n) (define (i386:mem+n->accu n)
`(,(if (< (abs n) #x80) `("mov____0x8(%eax),%eax" (#:immediate1 ,n)) `(,(if (< (abs n) #x80) `("mov____0x8(%eax),%eax" (#:immediate1 ,n))

3
module/mes/as-i386.scm
View File

@ -48,7 +48,9 @@
i386:byte-accu->local+n i386:byte-accu->local+n
i386:word-accu->local+n i386:word-accu->local+n
i386:accu->local+n i386:accu->local+n
i386:accu-and
i386:accu-and-base i386:accu-and-base
i386:accu-and-base-mem
i386:accu-base i386:accu-base
i386:accu-cmp-value i386:accu-cmp-value
i386:accu-mem-add i386:accu-mem-add
@ -56,6 +58,7 @@
i386:accu-negate i386:accu-negate
i386:accu-not i386:accu-not
i386:accu-or-base i386:accu-or-base
i386:accu-or-base-mem
i386:accu-shl i386:accu-shl
i386:accu-test i386:accu-test
i386:accu-xor-base i386:accu-xor-base

67
scaffold/tests/7q-bit-field.c Normal file
View File

@ -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;
}

4
stage0/x86.M1
View File

@ -37,7 +37,9 @@ DEFINE add____%eax,%eax 01c0
DEFINE add____%ebp,%eax 01e8 DEFINE add____%ebp,%eax 01e8
DEFINE add____%edx,%eax 01d0 DEFINE add____%edx,%eax 01d0
DEFINE add____%edx,%eax 01d0 DEFINE add____%edx,%eax 01d0
DEFINE and____$i32,%eax 25
DEFINE and____%edx,%eax 21d0 DEFINE and____%edx,%eax 21d0
DEFINE and____(%edx),%eax 2302
DEFINE call32 e8 DEFINE call32 e8
DEFINE call___*%eax ffd0 DEFINE call___*%eax ffd0
DEFINE cmp____$0x32,%eax 3d DEFINE cmp____$0x32,%eax 3d
@ -116,6 +118,7 @@ DEFINE mov____%edx,0x8(%ebp) 8955
DEFINE mov____%esp,%ebp 89e5 DEFINE mov____%esp,%ebp 89e5
DEFINE mov____(%eax),%eax 8b00 DEFINE mov____(%eax),%eax 8b00
DEFINE mov____(%eax),%ecx 8b08 DEFINE mov____(%eax),%ecx 8b08
DEFINE mov____(%edx),%eax 8b02
DEFINE mov____(%edx),%ecx 8b0a DEFINE mov____(%edx),%ecx 8b0a
DEFINE mov____(%edx),%edx 8b12 DEFINE mov____(%edx),%edx 8b12
DEFINE mov____0x32(%eax),%eax 8b80 DEFINE mov____0x32(%eax),%eax 8b80
@ -157,6 +160,7 @@ DEFINE mul____%edx f7e2
DEFINE nop 90 DEFINE nop 90
DEFINE not____%eax f7d0 DEFINE not____%eax f7d0
DEFINE or_____%edx,%eax 09d0 DEFINE or_____%edx,%eax 09d0
DEFINE or_____(%edx),%eax 0b02
DEFINE pop____%eax 58 DEFINE pop____%eax 58
DEFINE pop____%edx 5a DEFINE pop____%edx 5a
DEFINE push___$i32 68 DEFINE push___$i32 68