mescc: Tinycc support: union.
* scaffold/tests/73-union.c: New file. * module/language/c99/compiler.mes (union->type-entry): New function. (decl->info): Support unions.
This commit is contained in:
parent
07ee1fbf4f
commit
3ae27f52e4
3
make.scm
3
make.scm
|
@ -151,7 +151,8 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
|
||||||
add-scaffold-test
|
add-scaffold-test
|
||||||
'("70-printf"
|
'("70-printf"
|
||||||
"71-struct-array"
|
"71-struct-array"
|
||||||
"72-typedef-struct-def"))
|
"72-typedef-struct-def"
|
||||||
|
"73-union"))
|
||||||
|
|
||||||
(add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
|
(add-target (group "check-scaffold-tests/7" #:dependencies (filter (target-prefix? "check-scaffold/tests/7") %targets)))
|
||||||
|
|
||||||
|
|
|
@ -125,7 +125,7 @@
|
||||||
|
|
||||||
(define (.type o)
|
(define (.type o)
|
||||||
(pmatch o
|
(pmatch o
|
||||||
((param-decl (decl-spec-list (type-spec ,type)) _) (decl->type type))
|
((param-decl (decl-spec-list (type-spec ,type)) _) (decl->ast-type type))
|
||||||
((param-decl ,type _) type)
|
((param-decl ,type _) type)
|
||||||
(_
|
(_
|
||||||
(format (current-error-port) "SKIP: .type =~a\n" o))))
|
(format (current-error-port) "SKIP: .type =~a\n" o))))
|
||||||
|
@ -186,7 +186,7 @@
|
||||||
(lambda (o)
|
(lambda (o)
|
||||||
(let* ((local o)
|
(let* ((local o)
|
||||||
(ptr (local:pointer local))
|
(ptr (local:pointer local))
|
||||||
(size (if (= ptr 1) (type->size info (local:type o))
|
(size (if (= ptr 1) (ast-type->size info (local:type o))
|
||||||
4)))
|
4)))
|
||||||
(if (= size 1)
|
(if (= size 1)
|
||||||
(wrap-as (i386:push-byte-local-de-ref (local:id o)))
|
(wrap-as (i386:push-byte-local-de-ref (local:id o)))
|
||||||
|
@ -197,7 +197,7 @@
|
||||||
(lambda (o)
|
(lambda (o)
|
||||||
(let* ((local o)
|
(let* ((local o)
|
||||||
(ptr (local:pointer local))
|
(ptr (local:pointer local))
|
||||||
(size (if (= ptr 2) (type->size info (local:type o));; URG
|
(size (if (= ptr 2) (ast-type->size info (local:type o));; URG
|
||||||
4)))
|
4)))
|
||||||
(if (= size 1)
|
(if (= size 1)
|
||||||
(wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
|
(wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
|
||||||
|
@ -224,7 +224,7 @@
|
||||||
(if local
|
(if local
|
||||||
(begin
|
(begin
|
||||||
(let* ((ptr (local:pointer local))
|
(let* ((ptr (local:pointer local))
|
||||||
(size (if (= ptr 1) (type->size info (local:type local))
|
(size (if (= ptr 1) (ast-type->size info (local:type local))
|
||||||
4)))
|
4)))
|
||||||
(if (= ptr -1) ((push-local-address (.locals info)) local)
|
(if (= ptr -1) ((push-local-address (.locals info)) local)
|
||||||
((push-local (.locals info)) local))))
|
((push-local (.locals info)) local))))
|
||||||
|
@ -311,7 +311,7 @@
|
||||||
(if local
|
(if local
|
||||||
(let* ((ptr (local:pointer local))
|
(let* ((ptr (local:pointer local))
|
||||||
(type (ident->type info o))
|
(type (ident->type info o))
|
||||||
(size (if (= ptr 0) (type->size info type)
|
(size (if (= ptr 0) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(case ptr
|
(case ptr
|
||||||
((-1) (wrap-as (i386:local-ptr->accu (local:id local))))
|
((-1) (wrap-as (i386:local-ptr->accu (local:id local))))
|
||||||
|
@ -322,7 +322,7 @@
|
||||||
(if global
|
(if global
|
||||||
(let* ((ptr (ident->pointer info o))
|
(let* ((ptr (ident->pointer info o))
|
||||||
(type (ident->type info o))
|
(type (ident->type info o))
|
||||||
(size (if (= ptr 1) (type->size info type)
|
(size (if (= ptr 1) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(case ptr
|
(case ptr
|
||||||
((-2) (list (i386:label->accu `(#:address ,o))))
|
((-2) (list (i386:label->accu `(#:address ,o))))
|
||||||
|
@ -337,7 +337,7 @@
|
||||||
(if local
|
(if local
|
||||||
(let* ((ptr (local:pointer local))
|
(let* ((ptr (local:pointer local))
|
||||||
(type (ident->type info o))
|
(type (ident->type info o))
|
||||||
(size (if (and type (= ptr 1)) (type->size info type)
|
(size (if (and type (= ptr 1)) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(case ptr
|
(case ptr
|
||||||
((-1) (wrap-as (i386:local-ptr->base (local:id local))))
|
((-1) (wrap-as (i386:local-ptr->base (local:id local))))
|
||||||
|
@ -363,7 +363,7 @@
|
||||||
(constant (assoc-ref (.constants info) o)))
|
(constant (assoc-ref (.constants info) o)))
|
||||||
(if local (let* ((ptr (local:pointer local))
|
(if local (let* ((ptr (local:pointer local))
|
||||||
(type (ident->type info o))
|
(type (ident->type info o))
|
||||||
(size (if (= ptr 1) (type->size info type)
|
(size (if (= ptr 1) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(wrap-as (i386:local-ptr->accu (local:id local))))
|
(wrap-as (i386:local-ptr->accu (local:id local))))
|
||||||
(if global (list (i386:label->accu `(#:address ,o)))
|
(if global (list (i386:label->accu `(#:address ,o)))
|
||||||
|
@ -377,7 +377,7 @@
|
||||||
(if local
|
(if local
|
||||||
(let* ((ptr (local:pointer local))
|
(let* ((ptr (local:pointer local))
|
||||||
(type (ident->type info o))
|
(type (ident->type info o))
|
||||||
(size (if (= ptr 1) (type->size info type)
|
(size (if (= ptr 1) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(wrap-as (i386:local-ptr->base (local:id local))))
|
(wrap-as (i386:local-ptr->base (local:id local))))
|
||||||
(if global (list (i386:label->base `(#:address ,o)))
|
(if global (list (i386:label->base `(#:address ,o)))
|
||||||
|
@ -405,7 +405,7 @@
|
||||||
(if local
|
(if local
|
||||||
(let* ((ptr (local:pointer local))
|
(let* ((ptr (local:pointer local))
|
||||||
(type (ident->type info o))
|
(type (ident->type info o))
|
||||||
(size (if (= ptr 1) (type->size info type)
|
(size (if (= ptr 1) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(wrap-as (append (i386:local->accu (local:id local))
|
(wrap-as (append (i386:local->accu (local:id local))
|
||||||
(if (= size 1) (i386:byte-base->accu-address)
|
(if (= size 1) (i386:byte-base->accu-address)
|
||||||
|
@ -490,12 +490,12 @@
|
||||||
|
|
||||||
((sizeof-expr (p-expr (ident ,name)))
|
((sizeof-expr (p-expr (ident ,name)))
|
||||||
(let* ((type (ident->type info name))
|
(let* ((type (ident->type info name))
|
||||||
(size (type->size info type)))
|
(size (ast-type->size info type)))
|
||||||
(append-text info (wrap-as (i386:value->accu size)))))
|
(append-text info (wrap-as (i386:value->accu size)))))
|
||||||
|
|
||||||
((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,name)))))
|
((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,name)))))
|
||||||
(let* ((type name)
|
(let* ((type name)
|
||||||
(size (type->size info type)))
|
(size (ast-type->size info type)))
|
||||||
(append-text info (wrap-as (i386:value->accu size)))))
|
(append-text info (wrap-as (i386:value->accu size)))))
|
||||||
|
|
||||||
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident (,name)))))))
|
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident (,name)))))))
|
||||||
|
@ -505,12 +505,12 @@
|
||||||
|
|
||||||
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
|
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
|
||||||
(let* ((type (list "struct" name))
|
(let* ((type (list "struct" name))
|
||||||
(size (type->size info type)))
|
(size (ast-type->size info type)))
|
||||||
(append-text info (wrap-as (i386:value->accu size)))))
|
(append-text info (wrap-as (i386:value->accu size)))))
|
||||||
|
|
||||||
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
|
((sizeof-type (type-name (decl-spec-list (type-spec (struct-ref (ident ,name))))))
|
||||||
(let* ((type (list "struct" name))
|
(let* ((type (list "struct" name))
|
||||||
(size (type->size info type)))
|
(size (ast-type->size info type)))
|
||||||
(append-text info (wrap-as (i386:value->accu size)))))
|
(append-text info (wrap-as (i386:value->accu size)))))
|
||||||
|
|
||||||
((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,type))) (abs-declr (pointer))))
|
((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,type))) (abs-declr (pointer))))
|
||||||
|
@ -522,7 +522,7 @@
|
||||||
((array-ref ,index (p-expr (ident ,array)))
|
((array-ref ,index (p-expr (ident ,array)))
|
||||||
(let* ((type (ident->type info array))
|
(let* ((type (ident->type info array))
|
||||||
(ptr (ident->pointer info array))
|
(ptr (ident->pointer info array))
|
||||||
(size (if (or (= ptr 1) (= ptr -1)) (type->size info type)
|
(size (if (or (= ptr 1) (= ptr -1)) (ast-type->size info type)
|
||||||
4))
|
4))
|
||||||
(info ((expr->accu* info) o)))
|
(info ((expr->accu* info) o)))
|
||||||
(append-text info (wrap-as (append (case size
|
(append-text info (wrap-as (append (case size
|
||||||
|
@ -570,7 +570,7 @@
|
||||||
((de-ref (p-expr (ident ,name)))
|
((de-ref (p-expr (ident ,name)))
|
||||||
(let* ((type (ident->type info name))
|
(let* ((type (ident->type info name))
|
||||||
(ptr (ident->pointer info name))
|
(ptr (ident->pointer info name))
|
||||||
(size (if (= ptr 1) (type->size info type)
|
(size (if (= ptr 1) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(append-text info (append (if (or #t (assoc-ref locals name)) ((ident->accu info) name)
|
(append-text info (append (if (or #t (assoc-ref locals name)) ((ident->accu info) name)
|
||||||
((ident-address->accu info) name))
|
((ident-address->accu info) name))
|
||||||
|
@ -581,7 +581,7 @@
|
||||||
(let* ((info ((expr->accu info) `(de-ref (p-expr (ident ,name)))))
|
(let* ((info ((expr->accu info) `(de-ref (p-expr (ident ,name)))))
|
||||||
(type (ident->type info name))
|
(type (ident->type info name))
|
||||||
(ptr (ident->pointer info name))
|
(ptr (ident->pointer info name))
|
||||||
(size (if (= ptr 1) (type->size info type)
|
(size (if (= ptr 1) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(append-text info ((ident-add info) name size))))
|
(append-text info ((ident-add info) name size))))
|
||||||
|
|
||||||
|
@ -749,7 +749,7 @@
|
||||||
((de-ref (p-expr (ident ,name)))
|
((de-ref (p-expr (ident ,name)))
|
||||||
(let* ((type (ident->type info name))
|
(let* ((type (ident->type info name))
|
||||||
(ptr (ident->pointer info name))
|
(ptr (ident->pointer info name))
|
||||||
(size (if (= ptr 1) (type->size info type)
|
(size (if (= ptr 1) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(append-text info (append (wrap-as (i386:accu->base))
|
(append-text info (append (wrap-as (i386:accu->base))
|
||||||
((base->ident-address info) name)))))
|
((base->ident-address info) name)))))
|
||||||
|
@ -765,7 +765,7 @@
|
||||||
(append-text info (wrap-as (i386:base->accu-address)))))
|
(append-text info (wrap-as (i386:base->accu-address)))))
|
||||||
((array-ref ,index (p-expr (ident ,array)))
|
((array-ref ,index (p-expr (ident ,array)))
|
||||||
(let* ((type (ident->type info array))
|
(let* ((type (ident->type info array))
|
||||||
(size (type->size info type))
|
(size (ast-type->size info type))
|
||||||
(info (append-text info (wrap-as (i386:push-accu))))
|
(info (append-text info (wrap-as (i386:push-accu))))
|
||||||
(info ((expr->accu* info) a))
|
(info ((expr->accu* info) a))
|
||||||
(info (append-text info (wrap-as (i386:pop-base)))))
|
(info (append-text info (wrap-as (i386:pop-base)))))
|
||||||
|
@ -816,7 +816,7 @@
|
||||||
(let* ((info ((expr->accu info) index))
|
(let* ((info ((expr->accu info) index))
|
||||||
(type (ident->type info array))
|
(type (ident->type info array))
|
||||||
(ptr (ident->pointer info array))
|
(ptr (ident->pointer info array))
|
||||||
(size (if (or (= ptr 1) (= ptr -1)) (type->size info type)
|
(size (if (or (= ptr 1) (= ptr -1)) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(append-text info (append (wrap-as (append (i386:accu->base)
|
(append-text info (append (wrap-as (append (i386:accu->base)
|
||||||
(if (eq? size 1) '()
|
(if (eq? size 1) '()
|
||||||
|
@ -892,12 +892,16 @@
|
||||||
(define (struct->type-entry name fields)
|
(define (struct->type-entry name fields)
|
||||||
(cons (list "struct" name) (make-type 'struct (apply + (map field:size fields)) 0 fields)))
|
(cons (list "struct" name) (make-type 'struct (apply + (map field:size fields)) 0 fields)))
|
||||||
|
|
||||||
|
(define (union->type-entry name fields)
|
||||||
|
(cons (list "struct" name) (make-type 'union (apply + (map field:size fields)) 0 fields)))
|
||||||
|
|
||||||
(define i386:type-alist
|
(define i386:type-alist
|
||||||
`(("char" . ,(make-type 'builtin 1 0 #f))
|
`(("char" . ,(make-type 'builtin 1 0 #f))
|
||||||
("short" . ,(make-type 'builtin 2 0 #f))
|
("short" . ,(make-type 'builtin 2 0 #f))
|
||||||
("int" . ,(make-type 'builtin 4 0 #f))
|
("int" . ,(make-type 'builtin 4 0 #f))
|
||||||
("long" . ,(make-type 'builtin 4 0 #f))
|
("long" . ,(make-type 'builtin 4 0 #f))
|
||||||
("long long" . ,(make-type 'builtin 8 0 #f))
|
("long long" . ,(make-type 'builtin 8 0 #f))
|
||||||
|
("void" . ,(make-type 'builtin 4 0 #f))
|
||||||
;; FIXME sign
|
;; FIXME sign
|
||||||
("unsigned char" . ,(make-type 'builtin 1 0 #f))
|
("unsigned char" . ,(make-type 'builtin 1 0 #f))
|
||||||
("unsigned short" . ,(make-type 'builtin 2 0 #f))
|
("unsigned short" . ,(make-type 'builtin 2 0 #f))
|
||||||
|
@ -911,27 +915,45 @@
|
||||||
((,name ,type ,size ,pointer) size)
|
((,name ,type ,size ,pointer) size)
|
||||||
(_ 4)))
|
(_ 4)))
|
||||||
|
|
||||||
(define (type->size info o)
|
(define (get-type types o)
|
||||||
|
(let ((t (assoc-ref types o)))
|
||||||
|
(pmatch t
|
||||||
|
((typedef ,next) (get-type types next))
|
||||||
|
(_ t))))
|
||||||
|
|
||||||
|
(define (ast-type->type info o)
|
||||||
(pmatch o
|
(pmatch o
|
||||||
((decl-spec-list (type-spec (fixed-type ,type)))
|
((decl-spec-list (type-spec (fixed-type ,type)))
|
||||||
(type->size info type))
|
(ast-type->type info type))
|
||||||
((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
|
((decl-spec-list (type-qual ,qual) (type-spec (fixed-type ,type)))
|
||||||
(type->type info type))
|
(ast-type->type info type))
|
||||||
((struct-ref (ident (,type)))
|
((struct-ref (ident (,type)))
|
||||||
(type->type info `("struct" ,type)))
|
(ast-type->type info `("struct" ,type)))
|
||||||
((struct-ref (ident ,type))
|
((struct-ref (ident ,type))
|
||||||
(type->size info `("struct" ,type)))
|
(ast-type->type info `("struct" ,type)))
|
||||||
(void 4)
|
((union-ref (ident ,type))
|
||||||
((void) 4)
|
(ast-type->type info `("struct" ,type)))
|
||||||
|
((void) (ast-type->type info "void"))
|
||||||
(_ (let ((type (get-type (.types info) o)))
|
(_ (let ((type (get-type (.types info) o)))
|
||||||
(if type (type:size type)
|
(if type type
|
||||||
(error "type->size: unsupported: " o))))))
|
(begin
|
||||||
|
(stderr "types: ~s\n" (.types info))
|
||||||
|
(error "ast-type->type: unsupported: " o)))))))
|
||||||
|
|
||||||
|
(define (ast-type->description info o)
|
||||||
|
(let ((type (ast-type->type info o)))
|
||||||
|
(type:description type)))
|
||||||
|
|
||||||
|
(define (ast-type->size info o)
|
||||||
|
(let ((type (ast-type->type info o)))
|
||||||
|
(type:size type)))
|
||||||
|
|
||||||
(define (field-offset info struct field)
|
(define (field-offset info struct field)
|
||||||
(let* ((fields (type->description info struct))
|
(let ((xtype (ast-type->type info struct)))
|
||||||
(prefix (and=> (member field (reverse fields) (lambda (a b) (equal? a (car b)))) cdr
|
(if (eq? (type:type xtype) 'union) 0
|
||||||
)))
|
(let* ((fields (type:description xtype))
|
||||||
(apply + (map field:size prefix))))
|
(prefix (and=> (member field (reverse fields) (lambda (a b) (equal? a (car b)))) cdr)))
|
||||||
|
(apply + (map field:size prefix))))))
|
||||||
|
|
||||||
(define (ast->type o)
|
(define (ast->type o)
|
||||||
(pmatch o
|
(pmatch o
|
||||||
|
@ -946,7 +968,7 @@
|
||||||
(_ (stderr "SKIP: type=~s\n" o)
|
(_ (stderr "SKIP: type=~s\n" o)
|
||||||
"int")))
|
"int")))
|
||||||
|
|
||||||
(define (decl->type o)
|
(define (decl->ast-type o)
|
||||||
(pmatch o
|
(pmatch o
|
||||||
((fixed-type ,type) type)
|
((fixed-type ,type) type)
|
||||||
((struct-ref (ident (,name))) (list "struct" name))
|
((struct-ref (ident (,name))) (list "struct" name))
|
||||||
|
@ -956,7 +978,7 @@
|
||||||
(list "struct" name)) ;; FIXME
|
(list "struct" name)) ;; FIXME
|
||||||
((typename ,name) name)
|
((typename ,name) name)
|
||||||
(,name name)
|
(,name name)
|
||||||
(_ (error "decl->type: unsupported: " o))))
|
(_ (error "decl->ast-type: unsupported: " o))))
|
||||||
|
|
||||||
(define (byte->hex.m1 o)
|
(define (byte->hex.m1 o)
|
||||||
(string-drop o 2))
|
(string-drop o 2))
|
||||||
|
@ -1125,7 +1147,7 @@
|
||||||
(list name type 4))
|
(list name type 4))
|
||||||
|
|
||||||
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
|
((comp-decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (comp-declr-list (comp-declr (ident ,name))))
|
||||||
(let ((size (type->size info `("struct" ,type))))
|
(let ((size (ast-type->size info `("struct" ,type))))
|
||||||
(list name type size 0)))
|
(list name type size 0)))
|
||||||
|
|
||||||
(_ (error "struct-field: unsupported: " o)))
|
(_ (error "struct-field: unsupported: " o)))
|
||||||
|
@ -1158,23 +1180,6 @@
|
||||||
(ident->type info array))
|
(ident->type info array))
|
||||||
(_ (error "p-expr->type: unsupported: " o))))
|
(_ (error "p-expr->type: unsupported: " o))))
|
||||||
|
|
||||||
(define (get-type types o)
|
|
||||||
(let ((t (assoc-ref types o)))
|
|
||||||
(pmatch t
|
|
||||||
((typedef ,next) (get-type types next))
|
|
||||||
(_ t))))
|
|
||||||
|
|
||||||
(define (type->description info o)
|
|
||||||
(pmatch o
|
|
||||||
((decl-spec-list (type-spec (fixed-type ,type)))
|
|
||||||
(type->description info type))
|
|
||||||
((struct-ref (ident ,type))
|
|
||||||
(type->description info `("struct" ,type)))
|
|
||||||
(_ (let ((type (get-type (.types info) o)))
|
|
||||||
(if (not type) (stderr "TYPES=~s\n" (.types info)))
|
|
||||||
(if type (type:description type)
|
|
||||||
(error "type->description: unsupported:" o))))))
|
|
||||||
|
|
||||||
(define (local-var? o) ;; formals < 0, locals > 0
|
(define (local-var? o) ;; formals < 0, locals > 0
|
||||||
(positive? (local:id o)))
|
(positive? (local:id o)))
|
||||||
|
|
||||||
|
@ -1268,6 +1273,13 @@
|
||||||
((decl (decl-spec-list (type-spec (struct-def (ident (,type)) ,field-list))))
|
((decl (decl-spec-list (type-spec (struct-def (ident (,type)) ,field-list))))
|
||||||
((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
|
((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
|
||||||
|
|
||||||
|
((decl (decl-spec-list (stor-spec ,spec) (type-spec (union-ref (ident (,type))))) ,init)
|
||||||
|
((decl->info info) `(decl (decl-spec-list (stor-spec ,spec) (type-spec (union-ref (ident ,type)))) ,init)))
|
||||||
|
((decl (decl-spec-list (type-spec (union-def (ident (,type)) ,field-list))))
|
||||||
|
((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,field-list))))))
|
||||||
|
|
||||||
|
((decl (decl-spec-list (type-spec (union-ref (ident (,type))))) (init-declr-list (init-declr (ident ,name) ,initzer)))
|
||||||
|
((decl->info info) `(decl (decl-spec-list (type-spec (union-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name) ,initzer)))))
|
||||||
|
|
||||||
|
|
||||||
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
|
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
|
||||||
|
@ -1312,30 +1324,25 @@
|
||||||
((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ident ,name))))
|
((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ident ,name))))
|
||||||
info)
|
info)
|
||||||
|
|
||||||
;; ST_DATA struct TCCState *tcc_state;
|
((decl (decl-spec-list (stor-spec (static)) ,type) (init-declr-list (init-declr (ident ,name))))
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
((decl->info info) `(decl (decl-spec-list ,type) (init-declr-list (init-declr (ident ,name)))))
|
||||||
info)
|
info)
|
||||||
|
|
||||||
|
;; extern foo *bar;
|
||||||
|
((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))
|
||||||
|
info)
|
||||||
|
|
||||||
|
((decl (decl-spec-list (stor-spec (static)) ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))
|
||||||
|
((decl->info info) `(decl (decl-spec-list ,type) (init-declr-list (init-declr (ptr-declr ,pointer (ident ,name)))))))
|
||||||
|
|
||||||
;; ST_DATA int ch, tok; -- TCC, why oh why so difficult?
|
;; ST_DATA int ch, tok; -- TCC, why oh why so difficult?
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name)) . ,rest))
|
((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name)) . ,rest))
|
||||||
info)
|
info)
|
||||||
|
|
||||||
;; ST_DATA const int *macro_ptr;
|
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
|
||||||
info)
|
|
||||||
|
|
||||||
;; ST_DATA TokenSym **table_ident;
|
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
|
|
||||||
info)
|
|
||||||
|
|
||||||
;; ST_DATA Section *text_section, *data_section, *bss_section; /* predefined sections */
|
;; ST_DATA Section *text_section, *data_section, *bss_section; /* predefined sections */
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name))) . ,rest))
|
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name))) . ,rest))
|
||||||
info)
|
info)
|
||||||
|
|
||||||
;; ST_DATA void **sym_pools;
|
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (void))) (init-declr-list (init-declr (ptr-declr (pointer (pointer)) (ident ,name)))))
|
|
||||||
info)
|
|
||||||
|
|
||||||
;; ST_DATA CType char_pointer_type, func_old_type, int_type, size_type;
|
;; ST_DATA CType char_pointer_type, func_old_type, int_type, size_type;
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name)) . ,rest))
|
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name)) . ,rest))
|
||||||
info)
|
info)
|
||||||
|
@ -1345,10 +1352,6 @@
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (array-of (ident ,name) (add (p-expr (fixed ,a)) (p-expr (fixed ,b))))) (init-declr (ptr-declr (pointer) (ident ,name2)))))
|
((decl (decl-spec-list (stor-spec (extern)) (type-spec (typename ,type))) (init-declr-list (init-declr (array-of (ident ,name) (add (p-expr (fixed ,a)) (p-expr (fixed ,b))))) (init-declr (ptr-declr (pointer) (ident ,name2)))))
|
||||||
info)
|
info)
|
||||||
|
|
||||||
;; ST_DATA char *funcname;
|
|
||||||
((decl (decl-spec-list (stor-spec (extern)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
|
||||||
info)
|
|
||||||
|
|
||||||
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name))))
|
||||||
(clone info #:types (cons (cons name (or (get-type types type) `(typedef ("struct" ,type)))) types)))
|
(clone info #:types (cons (cons name (or (get-type types type) `(typedef ("struct" ,type)))) types)))
|
||||||
|
|
||||||
|
@ -1361,11 +1364,18 @@
|
||||||
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
||||||
((decl->info info) `(decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name))))))
|
((decl->info info) `(decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name))))))
|
||||||
|
|
||||||
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
||||||
|
((decl->info info) `(decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name))))))
|
||||||
|
|
||||||
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (struct-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
||||||
(let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
|
(let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) ,field-list))))))
|
||||||
(types (.types info)))
|
(types (.types info)))
|
||||||
(clone info #:types (cons (cons name (or (get-type types `("struct" ,type)) `(typedef ,type))) types))))
|
(clone info #:types (cons (cons name (or (get-type types `("struct" ,type)) `(typedef ,type))) types))))
|
||||||
|
|
||||||
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,type) ,field-list))) (init-declr-list (init-declr (ident ,name))))
|
||||||
|
(let* ((info ((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,field-list))))))
|
||||||
|
(types (.types info)))
|
||||||
|
(clone info #:types (cons (cons name (or (get-type types `("struct" ,type)) `(typedef ,type))) types))))
|
||||||
|
|
||||||
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
|
||||||
(let* ((type (get-type types type))
|
(let* ((type (get-type types type))
|
||||||
|
@ -1398,7 +1408,7 @@
|
||||||
|
|
||||||
;; char **p = *x;
|
;; char **p = *x;
|
||||||
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer (pointer)) (ident ,name)) (initzer (de-ref (p-expr (ident ,value)))))))
|
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer (pointer)) (ident ,name)) (initzer (de-ref (p-expr (ident ,value)))))))
|
||||||
(let ((type (decl->type type))
|
(let ((type (decl->ast-type type))
|
||||||
(info (append-text info (ast->comment o))))
|
(info (append-text info (ast->comment o))))
|
||||||
(if (.function info)
|
(if (.function info)
|
||||||
(let* ((locals (add-local locals name type 2))
|
(let* ((locals (add-local locals name type 2))
|
||||||
|
@ -1415,14 +1425,14 @@
|
||||||
(if (.function info)
|
(if (.function info)
|
||||||
(let* ((local (car (add-local locals name type -1)))
|
(let* ((local (car (add-local locals name type -1)))
|
||||||
(count (string->number count))
|
(count (string->number count))
|
||||||
(size (type->size info type))
|
(size (ast-type->size info type))
|
||||||
(local (make-local-entry name type -1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
|
(local (make-local-entry name type -1 (+ (local:id (cdr local)) -1 (quotient (+ (* count size) 3) 4))))
|
||||||
(locals (cons local locals))
|
(locals (cons local locals))
|
||||||
(info (clone info #:locals locals)))
|
(info (clone info #:locals locals)))
|
||||||
info)
|
info)
|
||||||
(let* ((globals (.globals info))
|
(let* ((globals (.globals info))
|
||||||
(count (cstring->number count))
|
(count (cstring->number count))
|
||||||
(size (type->size info type))
|
(size (ast-type->size info type))
|
||||||
(array (make-global-entry name type -1 (string->list (make-string (* count size) #\nul))))
|
(array (make-global-entry name type -1 (string->list (make-string (* count size) #\nul))))
|
||||||
(globals (append globals (list array))))
|
(globals (append globals (list array))))
|
||||||
(clone info #:globals globals)))))
|
(clone info #:globals globals)))))
|
||||||
|
@ -1432,7 +1442,7 @@
|
||||||
(error "TODO: " o)
|
(error "TODO: " o)
|
||||||
(let* ((globals (.globals info))
|
(let* ((globals (.globals info))
|
||||||
;; (count (cstring->number count))
|
;; (count (cstring->number count))
|
||||||
;; (size (type->size info type))
|
;; (size (ast-type->size info type))
|
||||||
(array (make-global-entry array type -1 (string->list string)))
|
(array (make-global-entry array type -1 (string->list string)))
|
||||||
(globals (append globals (list array))))
|
(globals (append globals (list array))))
|
||||||
(clone info #:globals globals))))
|
(clone info #:globals globals))))
|
||||||
|
@ -1455,7 +1465,7 @@
|
||||||
;; char *p = g_cells;
|
;; char *p = g_cells;
|
||||||
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (ident ,value))))))
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (ident ,value))))))
|
||||||
(let ((info (append-text info (ast->comment o)))
|
(let ((info (append-text info (ast->comment o)))
|
||||||
(type (decl->type type)))
|
(type (decl->ast-type type)))
|
||||||
(if (.function info)
|
(if (.function info)
|
||||||
(let* ((locals (add-local locals name type 1))
|
(let* ((locals (add-local locals name type 1))
|
||||||
(info (clone info #:locals locals)))
|
(info (clone info #:locals locals)))
|
||||||
|
@ -1482,18 +1492,29 @@
|
||||||
(let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
|
(let ((type-entry (struct->type-entry name (map (struct-field info) fields))))
|
||||||
(clone info #:types (cons type-entry types))))
|
(clone info #:types (cons type-entry types))))
|
||||||
|
|
||||||
|
((decl (decl-spec-list (type-spec (union-def (ident ,name) (field-list . ,fields)))))
|
||||||
|
(let ((type-entry (union->type-entry name (map (struct-field info) fields))))
|
||||||
|
(clone info #:types (cons type-entry types))))
|
||||||
|
|
||||||
((decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))
|
((decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))
|
||||||
(init-declr-list (init-declr (ident ,name))))
|
(init-declr-list (init-declr (ident ,name))))
|
||||||
(let ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))))))
|
(let ((info ((decl->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,type) (field-list . ,fields))))))))
|
||||||
((decl->info info) `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
|
((decl->info info) `(decl (decl-spec-list (type-spec (struct-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
|
||||||
|
|
||||||
|
((decl (decl-spec-list (stor-spec (typedef)) (type-spec (union-def (ident ,type) ,fields))) (init-declr-list (init-declr (ident ,name))))
|
||||||
|
(let ((info ((decl->info info) `(decl (decl-spec-list (type-spec (union-def (ident ,type) ,fields)))))))
|
||||||
|
((decl->info info) `(decl (decl-spec-list (type-spec (union-ref (ident ,type)))) (init-declr-list (init-declr (ident ,name)))))))
|
||||||
|
|
||||||
;; struct f = {...};
|
;; struct f = {...};
|
||||||
;; LOCALS!
|
;; LOCALS!
|
||||||
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers)))))
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer (initzer-list . ,initzers)))))
|
||||||
(let* ((info (append-text info (ast->comment o)))
|
(let* ((info (append-text info (ast->comment o)))
|
||||||
(type (decl->type type))
|
(type (decl->ast-type type))
|
||||||
(fields (type->description info type))
|
(fields (ast-type->description info type))
|
||||||
(size (type->size info type))
|
(xtype (ast-type->type info type))
|
||||||
|
(fields (if (not (eq? (type:type xtype) 'union)) fields
|
||||||
|
(list-head fields 1)))
|
||||||
|
(size (ast-type->size info type))
|
||||||
(initzers (map (initzer->non-const info) initzers)))
|
(initzers (map (initzer->non-const info) initzers)))
|
||||||
(if (.function info)
|
(if (.function info)
|
||||||
(let* ((initzer-globals (filter identity (append-map (initzer->globals globals) initzers)))
|
(let* ((initzer-globals (filter identity (append-map (initzer->globals globals) initzers)))
|
||||||
|
@ -1529,7 +1550,7 @@
|
||||||
;; DECL
|
;; DECL
|
||||||
;; char *bla[] = {"a", "b"};
|
;; char *bla[] = {"a", "b"};
|
||||||
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers)))))
|
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers)))))
|
||||||
(let* ((type (decl->type type))
|
(let* ((type (decl->ast-type type))
|
||||||
(entries (filter identity (append-map (initzer->globals globals) initzers)))
|
(entries (filter identity (append-map (initzer->globals globals) initzers)))
|
||||||
(entry-size 4)
|
(entry-size 4)
|
||||||
(size (* (length entries) entry-size))
|
(size (* (length entries) entry-size))
|
||||||
|
@ -1544,7 +1565,7 @@
|
||||||
|
|
||||||
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
|
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr ,init . ,initzer)))
|
||||||
(let* ((info (type->info info type))
|
(let* ((info (type->info info type))
|
||||||
(type (decl->type type))
|
(type (decl->ast-type type))
|
||||||
(name (init-declr->name init))
|
(name (init-declr->name init))
|
||||||
(pointer (init-declr->pointer init))
|
(pointer (init-declr->pointer init))
|
||||||
(initzer-globals (if (null? initzer) '()
|
(initzer-globals (if (null? initzer) '()
|
||||||
|
@ -1556,7 +1577,7 @@
|
||||||
(globals (append globals initzer-globals))
|
(globals (append globals initzer-globals))
|
||||||
(info (clone info #:globals globals))
|
(info (clone info #:globals globals))
|
||||||
(pointer (if (and (pair? type) (equal? (car type) "struct")) -1 pointer))
|
(pointer (if (and (pair? type) (equal? (car type) "struct")) -1 pointer))
|
||||||
(size (if (zero? pointer) (type->size info type)
|
(size (if (zero? pointer) (ast-type->size info type)
|
||||||
4)))
|
4)))
|
||||||
(if (.function info)
|
(if (.function info)
|
||||||
(let* ((locals (if (or (not (= pointer 0)) (<= size 4)) (add-local locals name type pointer)
|
(let* ((locals (if (or (not (= pointer 0)) (<= size 4)) (add-local locals name type pointer)
|
||||||
|
|
50
scaffold/tests/73-union.c
Normal file
50
scaffold/tests/73-union.c
Normal file
|
@ -0,0 +1,50 @@
|
||||||
|
/* -*-comment-start: "//";comment-end:""-*-
|
||||||
|
* Mes --- Maxwell Equations of Software
|
||||||
|
* Copyright © 2017 Jan 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/>.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include "30-test.i"
|
||||||
|
#include <stdio.h>
|
||||||
|
|
||||||
|
typedef union foo
|
||||||
|
{
|
||||||
|
char c;
|
||||||
|
int i;
|
||||||
|
void *p;
|
||||||
|
} foo;
|
||||||
|
|
||||||
|
typedef union
|
||||||
|
{
|
||||||
|
char c;
|
||||||
|
int i;
|
||||||
|
void *p;
|
||||||
|
} bar;
|
||||||
|
|
||||||
|
|
||||||
|
int
|
||||||
|
test ()
|
||||||
|
{
|
||||||
|
union foo f = {48};
|
||||||
|
printf ("f.i=%d\n", f.i);
|
||||||
|
printf ("f.c=%c\n", f.c);
|
||||||
|
|
||||||
|
if (f.i != 48) return 1;
|
||||||
|
if (f.c != '0') return 1;
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
Loading…
Reference in a new issue