mescc: Tinycc support: Implement (foo--)->bar and permutations.
* module/language/c99/info.scm (clone): Add post field. (make): Handle post parameter. * module/language/c99/compiler.mes (clone): Handle post parameter. (expr->accu*): Set it to support foo--/foo--. (expr->accu): Read it to support foo--/foo--. * scaffold/tests/7o-struct-pre-post.c: Test it. * build-aux/check-mescc.sh: Run it.
This commit is contained in:
Jan Nieuwenhuizen
parent
330404125e
commit
057607ca0a
|
|
@ -111,6 +111,7 @@ t
|
||||||
7l-struct-any-size-array
|
7l-struct-any-size-array
|
||||||
7m-struct-char-array-assign
|
7m-struct-char-array-assign
|
||||||
7n-struct-struct-array
|
7n-struct-struct-array
|
||||||
|
7o-struct-pre-post
|
||||||
80-setjmp
|
80-setjmp
|
||||||
81-qsort
|
81-qsort
|
||||||
82-define
|
82-define
|
||||||
|
|
|
||||||
|
|
@ -115,6 +115,7 @@
|
||||||
(statics (.statics o))
|
(statics (.statics o))
|
||||||
(function (.function o))
|
(function (.function o))
|
||||||
(text (.text o))
|
(text (.text o))
|
||||||
|
(post (.post o))
|
||||||
(break (.break o))
|
(break (.break o))
|
||||||
(continue (.continue o)))
|
(continue (.continue o)))
|
||||||
(let-keywords rest
|
(let-keywords rest
|
||||||
|
|
@ -127,9 +128,10 @@
|
||||||
(statics statics)
|
(statics statics)
|
||||||
(function function)
|
(function function)
|
||||||
(text text)
|
(text text)
|
||||||
|
(post post)
|
||||||
(break break)
|
(break break)
|
||||||
(continue continue))
|
(continue continue))
|
||||||
(make <info> #:types types #:constants constants #:functions functions #:globals globals #:locals locals #:statics statics #:function function #:text text #:break break #:continue continue))))))
|
(make <info> #:types types #:constants constants #:functions functions #:globals globals #:locals locals #:statics statics #:function function #:text text #:post post #:break break #:continue continue))))))
|
||||||
|
|
||||||
(define (ident->constant name value)
|
(define (ident->constant name value)
|
||||||
(cons name value))
|
(cons name value))
|
||||||
|
|
@ -810,6 +812,66 @@
|
||||||
(info (expr->base array info)))
|
(info (expr->base array info)))
|
||||||
(append-text info (wrap-as (i386:accu+base)))))
|
(append-text info (wrap-as (i386:accu+base)))))
|
||||||
|
|
||||||
|
;;((cast (type-name (decl-spec-list (type-spec (typename "Elf32_Rel"))) (abs-declr (pointer))) (add (i-sel (ident "data") (p-expr (ident "sr"))) (p-expr (ident "a")))))
|
||||||
|
|
||||||
|
((cast ,type ,expr)
|
||||||
|
(expr->accu expr info))
|
||||||
|
|
||||||
|
;; ((post-dec (p-expr (ident "vtop"))))
|
||||||
|
|
||||||
|
;; ((cast ,type ,expr)
|
||||||
|
;; (expr->accu `(ref-to ,expr) 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))
|
||||||
|
|
||||||
|
((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))))
|
(_ (error "expr->accu*: not supported: " o))))
|
||||||
|
|
||||||
(define (expr-add info)
|
(define (expr-add info)
|
||||||
|
|
@ -820,392 +882,396 @@
|
||||||
|
|
||||||
(define (expr->accu o info)
|
(define (expr->accu o info)
|
||||||
(let ((locals (.locals info))
|
(let ((locals (.locals info))
|
||||||
(constants (.constants info))
|
|
||||||
(text (.text info))
|
(text (.text info))
|
||||||
(globals (.globals info)))
|
(globals (.globals info)))
|
||||||
(pmatch o
|
(define (helper)
|
||||||
((expr) info)
|
(pmatch o
|
||||||
|
((expr) info)
|
||||||
|
|
||||||
((comma-expr) info)
|
((comma-expr) info)
|
||||||
|
|
||||||
((comma-expr ,a . ,rest)
|
((comma-expr ,a . ,rest)
|
||||||
(let ((info (expr->accu a info)))
|
(let ((info (expr->accu a info)))
|
||||||
(expr->accu `(comma-expr ,@rest) info)))
|
(expr->accu `(comma-expr ,@rest) info)))
|
||||||
|
|
||||||
((p-expr (string ,string))
|
((p-expr (string ,string))
|
||||||
(let* ((globals ((globals:add-string globals) string))
|
(let* ((globals ((globals:add-string globals) string))
|
||||||
(info (clone info #:globals globals)))
|
(info (clone info #:globals globals)))
|
||||||
(append-text info (list (i386:label->accu `(#:string ,string))))))
|
(append-text info (list (i386:label->accu `(#:string ,string))))))
|
||||||
|
|
||||||
((p-expr (fixed ,value))
|
((p-expr (fixed ,value))
|
||||||
(let ((value (cstring->number value)))
|
(let ((value (cstring->number value)))
|
||||||
(append-text info (wrap-as (i386:value->accu value)))))
|
(append-text info (wrap-as (i386:value->accu value)))))
|
||||||
|
|
||||||
((neg (p-expr (fixed ,value)))
|
((neg (p-expr (fixed ,value)))
|
||||||
(let ((value (- (cstring->number value))))
|
(let ((value (- (cstring->number value))))
|
||||||
(append-text info (wrap-as (i386:value->accu value)))))
|
(append-text info (wrap-as (i386:value->accu value)))))
|
||||||
|
|
||||||
((p-expr (char ,char))
|
((p-expr (char ,char))
|
||||||
(let ((char (char->integer (car (string->list char)))))
|
(let ((char (char->integer (car (string->list char)))))
|
||||||
(append-text info (wrap-as (i386:value->accu char)))))
|
(append-text info (wrap-as (i386:value->accu char)))))
|
||||||
|
|
||||||
((p-expr (string . ,strings))
|
((p-expr (string . ,strings))
|
||||||
(append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
|
(append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
|
||||||
|
|
||||||
((p-expr (ident ,name))
|
((p-expr (ident ,name))
|
||||||
(append-text info ((ident->accu info) name)))
|
(append-text info ((ident->accu info) name)))
|
||||||
|
|
||||||
((initzer ,initzer)
|
((initzer ,initzer)
|
||||||
(expr->accu initzer info))
|
(expr->accu initzer info))
|
||||||
|
|
||||||
;; offsetoff
|
;; offsetoff
|
||||||
((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
|
((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
|
||||||
(let* ((type (ast->basic-type struct info))
|
(let* ((type (ast->basic-type struct info))
|
||||||
(offset (field-offset info type field))
|
(offset (field-offset info type field))
|
||||||
(base (cstring->number base)))
|
(base (cstring->number base)))
|
||||||
(append-text info (wrap-as (i386:value->accu (+ base offset))))))
|
(append-text info (wrap-as (i386:value->accu (+ base offset))))))
|
||||||
|
|
||||||
;; &foo
|
;; &foo
|
||||||
((ref-to (p-expr (ident ,name)))
|
((ref-to (p-expr (ident ,name)))
|
||||||
(append-text info ((ident-address->accu info) name)))
|
(append-text info ((ident-address->accu info) name)))
|
||||||
|
|
||||||
;; &*foo
|
;; &*foo
|
||||||
((ref-to (de-ref ,expr))
|
((ref-to (de-ref ,expr))
|
||||||
(expr->accu expr info))
|
(expr->accu expr info))
|
||||||
|
|
||||||
((ref-to ,expr)
|
((ref-to ,expr)
|
||||||
(expr->accu* expr info))
|
(expr->accu* expr info))
|
||||||
|
|
||||||
((sizeof-expr ,expr)
|
((sizeof-expr ,expr)
|
||||||
(append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
|
(append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
|
||||||
|
|
||||||
((sizeof-type ,type)
|
((sizeof-type ,type)
|
||||||
(append-text info (wrap-as (i386:value->accu (ast->size type info)))))
|
(append-text info (wrap-as (i386:value->accu (ast->size type info)))))
|
||||||
|
|
||||||
((array-ref ,index ,array)
|
((array-ref ,index ,array)
|
||||||
(let* ((info (expr->accu* o info))
|
(let* ((info (expr->accu* o info))
|
||||||
(size (ast->size o info)))
|
(size (ast->size o info)))
|
||||||
(append-text info (wrap-as (case size
|
(append-text info (wrap-as (case size
|
||||||
((1) (i386:byte-mem->accu))
|
((1) (i386:byte-mem->accu))
|
||||||
((2) (i386:word-mem->accu))
|
((2) (i386:word-mem->accu))
|
||||||
((4) (i386:mem->accu))
|
((4) (i386:mem->accu))
|
||||||
(else '()))))))
|
(else '()))))))
|
||||||
|
|
||||||
((d-sel ,field ,struct)
|
((d-sel ,field ,struct)
|
||||||
(let* ((info (expr->accu* o info))
|
(let* ((info (expr->accu* o info))
|
||||||
(info (append-text info (ast->comment o)))
|
(info (append-text info (ast->comment o)))
|
||||||
(type (ast->type o info))
|
(type (ast->type o info))
|
||||||
(size (->size type))
|
(size (->size type))
|
||||||
(array? (c-array? type)))
|
(array? (c-array? type)))
|
||||||
(if array? info
|
(if array? info
|
||||||
(append-text info (wrap-as (case size
|
(append-text info (wrap-as (case size
|
||||||
((1) (i386:byte-mem->accu))
|
((1) (i386:byte-mem->accu))
|
||||||
((2) (i386:word-mem->accu))
|
((2) (i386:word-mem->accu))
|
||||||
((4) (i386:mem->accu))
|
((4) (i386:mem->accu))
|
||||||
(else '())))))))
|
(else '())))))))
|
||||||
|
|
||||||
((i-sel ,field ,struct)
|
((i-sel ,field ,struct)
|
||||||
(let* ((info (expr->accu* o info))
|
(let* ((info (expr->accu* o info))
|
||||||
(info (append-text info (ast->comment o)))
|
(info (append-text info (ast->comment o)))
|
||||||
(type (ast->type o info))
|
(type (ast->type o info))
|
||||||
(size (->size type))
|
(size (->size type))
|
||||||
(array? (c-array? type)))
|
(array? (c-array? type)))
|
||||||
(if array? info
|
(if array? info
|
||||||
(append-text info (wrap-as (case size
|
(append-text info (wrap-as (case size
|
||||||
((1) (i386:byte-mem->accu))
|
((1) (i386:byte-mem->accu))
|
||||||
((2) (i386:word-mem->accu))
|
((2) (i386:word-mem->accu))
|
||||||
((4) (i386:mem->accu))
|
((4) (i386:mem->accu))
|
||||||
(else '())))))))
|
(else '())))))))
|
||||||
|
|
||||||
((de-ref ,expr)
|
((de-ref ,expr)
|
||||||
(let* ((info (expr->accu expr info))
|
(let* ((info (expr->accu expr info))
|
||||||
(size (ast->size o info)))
|
(size (ast->size o info)))
|
||||||
(append-text info (wrap-as (case size
|
(append-text info (wrap-as (case size
|
||||||
((1) (i386:byte-mem->accu))
|
((1) (i386:byte-mem->accu))
|
||||||
((2) (i386:word-mem->accu))
|
((2) (i386:word-mem->accu))
|
||||||
((4) (i386:mem->accu))
|
((4) (i386:mem->accu))
|
||||||
(else '()))))))
|
(else '()))))))
|
||||||
|
|
||||||
((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
|
((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
|
||||||
(if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
|
(if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
|
||||||
(append-text info (wrap-as (asm->m1 arg0))))
|
(append-text info (wrap-as (asm->m1 arg0))))
|
||||||
(let* ((text-length (length text))
|
(let* ((text-length (length text))
|
||||||
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
||||||
(if (null? expressions) info
|
(if (null? expressions) info
|
||||||
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
||||||
(n (length expr-list)))
|
(n (length expr-list)))
|
||||||
(if (not (assoc-ref locals name))
|
(if (not (assoc-ref locals name))
|
||||||
(begin
|
(begin
|
||||||
(if (and (not (assoc name (.functions info)))
|
(if (and (not (assoc name (.functions info)))
|
||||||
(not (assoc name globals))
|
(not (assoc name globals))
|
||||||
(not (equal? name (.function info))))
|
(not (equal? name (.function info))))
|
||||||
(stderr "warning: undeclared function: ~a\n" name))
|
(stderr "warning: undeclared function: ~a\n" name))
|
||||||
(append-text args-info (list (i386:call-label name n))))
|
(append-text args-info (list (i386:call-label name n))))
|
||||||
(let* ((empty (clone info #:text '()))
|
(let* ((empty (clone info #:text '()))
|
||||||
(accu (expr->accu `(p-expr (ident ,name)) empty)))
|
(accu (expr->accu `(p-expr (ident ,name)) empty)))
|
||||||
(append-text args-info (append (.text accu)
|
(append-text args-info (append (.text accu)
|
||||||
(list (i386:call-accu n)))))))))
|
(list (i386:call-accu n)))))))))
|
||||||
|
|
||||||
((fctn-call ,function (expr-list . ,expr-list))
|
((fctn-call ,function (expr-list . ,expr-list))
|
||||||
(let* ((text-length (length text))
|
(let* ((text-length (length text))
|
||||||
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
||||||
(if (null? expressions) info
|
(if (null? expressions) info
|
||||||
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
||||||
(n (length expr-list))
|
(n (length expr-list))
|
||||||
(empty (clone info #:text '()))
|
(empty (clone info #:text '()))
|
||||||
(accu (expr->accu function empty)))
|
(accu (expr->accu function empty)))
|
||||||
(append-text args-info (append (.text accu)
|
(append-text args-info (append (.text accu)
|
||||||
(list (i386:call-accu n))))))
|
(list (i386:call-accu n))))))
|
||||||
|
|
||||||
((cond-expr . ,cond-expr)
|
((cond-expr . ,cond-expr)
|
||||||
(ast->info `(expr-stmt ,o) info))
|
(ast->info `(expr-stmt ,o) info))
|
||||||
|
|
||||||
((post-inc ,expr)
|
((post-inc ,expr)
|
||||||
(let* ((info (append (expr->accu expr info)))
|
(let* ((info (append (expr->accu expr info)))
|
||||||
(info (append-text info (wrap-as (i386:push-accu))))
|
(info (append-text info (wrap-as (i386:push-accu))))
|
||||||
(rank (expr->rank info expr))
|
(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-text info (wrap-as (i386:pop-accu)))))
|
(info (append-text info (wrap-as (i386:pop-accu)))))
|
||||||
info))
|
info))
|
||||||
|
|
||||||
((post-dec ,expr)
|
((post-dec ,expr)
|
||||||
(let* ((info (append (expr->accu expr info)))
|
(let* ((info (append (expr->accu expr info)))
|
||||||
(info (append-text info (wrap-as (i386:push-accu))))
|
(info (append-text info (wrap-as (i386:push-accu))))
|
||||||
(rank (expr->rank info expr))
|
(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-text info (wrap-as (i386:pop-accu)))))
|
(info (append-text info (wrap-as (i386:pop-accu)))))
|
||||||
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))
|
||||||
|
|
||||||
((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))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
((add ,a (p-expr (fixed ,value)))
|
((add ,a (p-expr (fixed ,value)))
|
||||||
(let* ((rank (expr->rank info a))
|
(let* ((rank (expr->rank info a))
|
||||||
(type (ast->basic-type a info))
|
(type (ast->basic-type a info))
|
||||||
(struct? (structured-type? type))
|
(struct? (structured-type? type))
|
||||||
(size (cond ((= rank 1) (ast-type->size info a))
|
(size (cond ((= rank 1) (ast-type->size info a))
|
||||||
((> rank 1) 4)
|
((> rank 1) 4)
|
||||||
((and struct? (= rank 2)) 4)
|
((and struct? (= rank 2)) 4)
|
||||||
(else 1)))
|
(else 1)))
|
||||||
(info (expr->accu a info))
|
(info (expr->accu a info))
|
||||||
(value (cstring->number value))
|
(value (cstring->number value))
|
||||||
(value (* size value)))
|
(value (* size value)))
|
||||||
(append-text info (wrap-as (i386:accu+value value)))))
|
(append-text info (wrap-as (i386:accu+value value)))))
|
||||||
|
|
||||||
((add ,a ,b)
|
((add ,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 (cond ((= rank 1) (ast-type->size info a))
|
(size (cond ((= rank 1) (ast-type->size info a))
|
||||||
((> rank 1) 4)
|
((> rank 1) 4)
|
||||||
((and struct? (= rank 2)) 4)
|
((and struct? (= rank 2)) 4)
|
||||||
(else 1))))
|
(else 1))))
|
||||||
(if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
|
(if (or (= size 1)) ((binop->accu info) a b (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)))))))
|
||||||
|
|
||||||
((sub ,a (p-expr (fixed ,value)))
|
((sub ,a (p-expr (fixed ,value)))
|
||||||
(let* ((rank (expr->rank info a))
|
(let* ((rank (expr->rank info a))
|
||||||
(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)))
|
||||||
(info (expr->accu a info))
|
(info (expr->accu a info))
|
||||||
(value (cstring->number value))
|
(value (cstring->number value))
|
||||||
(value (* size value)))
|
(value (* size value)))
|
||||||
(append-text info (wrap-as (i386:accu+value (- value))))))
|
(append-text info (wrap-as (i386:accu+value (- value))))))
|
||||||
|
|
||||||
((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)))))))
|
||||||
|
|
||||||
((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
|
((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
|
||||||
((bitwise-not ,expr)
|
((bitwise-not ,expr)
|
||||||
(let ((info (ast->info expr info)))
|
(let ((info (ast->info expr info)))
|
||||||
(append-text info (wrap-as (i386:accu-not)))))
|
(append-text info (wrap-as (i386:accu-not)))))
|
||||||
((bitwise-or ,a ,b) ((binop->accu info) a b (i386:accu-or-base)))
|
((bitwise-or ,a ,b) ((binop->accu info) a b (i386:accu-or-base)))
|
||||||
((bitwise-xor ,a ,b) ((binop->accu info) a b (i386:accu-xor-base)))
|
((bitwise-xor ,a ,b) ((binop->accu info) a b (i386:accu-xor-base)))
|
||||||
((lshift ,a ,b) ((binop->accu info) a b (i386:accu<<base)))
|
((lshift ,a ,b) ((binop->accu info) a b (i386:accu<<base)))
|
||||||
((rshift ,a ,b) ((binop->accu info) a b (i386:accu>>base)))
|
((rshift ,a ,b) ((binop->accu info) a b (i386:accu>>base)))
|
||||||
((div ,a ,b) ((binop->accu info) a b (i386:accu/base)))
|
((div ,a ,b) ((binop->accu info) a b (i386:accu/base)))
|
||||||
((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
|
((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
|
||||||
((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
|
((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
|
||||||
|
|
||||||
((not ,expr)
|
((not ,expr)
|
||||||
(let* ((test-info (ast->info expr info)))
|
(let* ((test-info (ast->info expr info)))
|
||||||
(clone info #:text
|
(clone info #:text
|
||||||
(append (.text test-info)
|
(append (.text test-info)
|
||||||
(wrap-as (i386:accu-negate)))
|
(wrap-as (i386:accu-negate)))
|
||||||
#:globals (.globals test-info))))
|
#:globals (.globals test-info))))
|
||||||
|
|
||||||
((neg ,expr)
|
((neg ,expr)
|
||||||
(let ((info (expr->base expr info)))
|
(let ((info (expr->base expr info)))
|
||||||
(append-text info (append (wrap-as (i386:value->accu 0))
|
(append-text info (append (wrap-as (i386:value->accu 0))
|
||||||
(wrap-as (i386:sub-base))))))
|
(wrap-as (i386:sub-base))))))
|
||||||
|
|
||||||
((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
|
((eq ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:z->accu))))
|
||||||
((ge ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:ge?->accu))))
|
((ge ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:ge?->accu))))
|
||||||
((gt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:g?->accu) (i386:accu-test))))
|
((gt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:g?->accu) (i386:accu-test))))
|
||||||
|
|
||||||
;; FIXME: set accu *and* flags
|
;; FIXME: set accu *and* flags
|
||||||
((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
|
((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
|
||||||
(i386:sub-base)
|
(i386:sub-base)
|
||||||
(i386:nz->accu)
|
(i386:nz->accu)
|
||||||
(i386:accu<->stack)
|
(i386:accu<->stack)
|
||||||
(i386:sub-base)
|
(i386:sub-base)
|
||||||
(i386:xor-zf)
|
(i386:xor-zf)
|
||||||
(i386:pop-accu))))
|
(i386:pop-accu))))
|
||||||
|
|
||||||
((ne ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:xor-zf))))
|
((ne ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:xor-zf))))
|
||||||
((le ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:le?->accu))))
|
((le ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:le?->accu))))
|
||||||
((lt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:l?->accu))))
|
((lt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:l?->accu))))
|
||||||
|
|
||||||
((or ,a ,b)
|
((or ,a ,b)
|
||||||
(let* ((info (expr->accu a info))
|
(let* ((info (expr->accu a info))
|
||||||
(here (number->string (length (.text info))))
|
(here (number->string (length (.text info))))
|
||||||
(skip-b-label (string-append "_" (.function info) "_" here "_or_skip_b"))
|
(skip-b-label (string-append "_" (.function info) "_" here "_or_skip_b"))
|
||||||
(info (append-text info (wrap-as (i386:accu-test))))
|
(info (append-text info (wrap-as (i386:accu-test))))
|
||||||
(info (append-text info (wrap-as (i386:jump-nz skip-b-label))))
|
(info (append-text info (wrap-as (i386:jump-nz skip-b-label))))
|
||||||
(info (append-text info (wrap-as (i386:accu-test))))
|
(info (append-text info (wrap-as (i386:accu-test))))
|
||||||
(info (expr->accu b info))
|
(info (expr->accu b info))
|
||||||
(info (append-text info (wrap-as (i386:accu-test))))
|
(info (append-text info (wrap-as (i386:accu-test))))
|
||||||
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
||||||
info))
|
info))
|
||||||
|
|
||||||
((and ,a ,b)
|
((and ,a ,b)
|
||||||
(let* ((info (expr->accu a info))
|
(let* ((info (expr->accu a info))
|
||||||
(here (number->string (length (.text info))))
|
(here (number->string (length (.text info))))
|
||||||
(skip-b-label (string-append "_" (.function info) "_" here "_and_skip_b"))
|
(skip-b-label (string-append "_" (.function info) "_" here "_and_skip_b"))
|
||||||
(info (append-text info (wrap-as (i386:accu-test))))
|
(info (append-text info (wrap-as (i386:accu-test))))
|
||||||
(info (append-text info (wrap-as (i386:jump-z skip-b-label))))
|
(info (append-text info (wrap-as (i386:jump-z skip-b-label))))
|
||||||
(info (append-text info (wrap-as (i386:accu-test))))
|
(info (append-text info (wrap-as (i386:accu-test))))
|
||||||
(info (expr->accu b info))
|
(info (expr->accu b info))
|
||||||
(info (append-text info (wrap-as (i386:accu-test))))
|
(info (append-text info (wrap-as (i386:accu-test))))
|
||||||
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
||||||
info))
|
info))
|
||||||
|
|
||||||
((cast ,type ,expr)
|
((cast ,type ,expr)
|
||||||
(expr->accu expr info))
|
(expr->accu expr info))
|
||||||
|
|
||||||
((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
|
((assn-expr (de-ref (post-inc (p-expr (ident ,name)))) (op ,op) ,b)
|
||||||
(let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
|
(let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
|
||||||
(type (ident->type info name))
|
(type (ident->type info name))
|
||||||
(rank (ident->rank info name))
|
(rank (ident->rank info name))
|
||||||
(size (if (> rank 1) 4 1)))
|
(size (if (> rank 1) 4 1)))
|
||||||
(append-text info ((ident-add info) name size))))
|
(append-text info ((ident-add info) name size))))
|
||||||
|
|
||||||
((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
|
((assn-expr (de-ref (post-dec (p-expr (ident ,name)))) (op ,op) ,b)
|
||||||
(let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
|
(let* ((info (expr->accu `(assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b) info))
|
||||||
(type (ident->type info name))
|
(type (ident->type info name))
|
||||||
(rank (ident->rank info name))
|
(rank (ident->rank info name))
|
||||||
(size (if (> rank 1) 4 1)))
|
(size (if (> rank 1) 4 1)))
|
||||||
(append-text info ((ident-add info) name (- size)))))
|
(append-text info ((ident-add info) name (- size)))))
|
||||||
|
|
||||||
((assn-expr ,a (op ,op) ,b)
|
((assn-expr ,a (op ,op) ,b)
|
||||||
(let* ((info (append-text info (ast->comment o)))
|
(let* ((info (append-text info (ast->comment o)))
|
||||||
(type (ast->type a info))
|
(type (ast->type a info))
|
||||||
(rank (->rank type))
|
(rank (->rank type))
|
||||||
(type-b (ast->type b info))
|
(type-b (ast->type b info))
|
||||||
(rank-b (->rank type-b))
|
(rank-b (->rank type-b))
|
||||||
(size (->size type))
|
(size (->size type))
|
||||||
(size-b (->size type-b))
|
(size-b (->size type-b))
|
||||||
(info (expr->accu b info))
|
(info (expr->accu b info))
|
||||||
(info (if (equal? op "=") info
|
(info (if (equal? op "=") info
|
||||||
(let* ((struct? (structured-type? type))
|
(let* ((struct? (structured-type? type))
|
||||||
(size (cond ((= rank 1) (ast-type->size info a))
|
(size (cond ((= rank 1) (ast-type->size info a))
|
||||||
((> rank 1) 4)
|
((> rank 1) 4)
|
||||||
((and struct? (= rank 2)) 4)
|
((and struct? (= rank 2)) 4)
|
||||||
(else 1)))
|
(else 1)))
|
||||||
(info (if (or (= size 1) (= rank-b 1)) info
|
(info (if (or (= size 1) (= rank-b 1)) info
|
||||||
(let ((info (append-text info (wrap-as (i386:value->base size)))))
|
(let ((info (append-text info (wrap-as (i386:value->base size)))))
|
||||||
(append-text info (wrap-as (i386:accu*base))))))
|
(append-text info (wrap-as (i386:accu*base))))))
|
||||||
(info (append-text info (wrap-as (i386:push-accu))))
|
(info (append-text info (wrap-as (i386:push-accu))))
|
||||||
(info (expr->accu a info))
|
(info (expr->accu a info))
|
||||||
(info (append-text info (wrap-as (i386:pop-base))))
|
(info (append-text info (wrap-as (i386:pop-base))))
|
||||||
(info (append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
|
(info (append-text info (cond ((equal? op "+=") (wrap-as (i386:accu+base)))
|
||||||
((equal? op "-=") (wrap-as (i386:accu-base)))
|
((equal? op "-=") (wrap-as (i386:accu-base)))
|
||||||
((equal? op "*=") (wrap-as (i386:accu*base)))
|
((equal? op "*=") (wrap-as (i386:accu*base)))
|
||||||
((equal? op "/=") (wrap-as (i386:accu/base)))
|
((equal? op "/=") (wrap-as (i386:accu/base)))
|
||||||
((equal? op "%=") (wrap-as (i386:accu%base)))
|
((equal? op "%=") (wrap-as (i386:accu%base)))
|
||||||
((equal? op "&=") (wrap-as (i386:accu-and-base)))
|
((equal? op "&=") (wrap-as (i386:accu-and-base)))
|
||||||
((equal? op "|=") (wrap-as (i386:accu-or-base)))
|
((equal? op "|=") (wrap-as (i386:accu-or-base)))
|
||||||
((equal? op "^=") (wrap-as (i386:accu-xor-base)))
|
((equal? op "^=") (wrap-as (i386:accu-xor-base)))
|
||||||
((equal? op ">>=") (wrap-as (i386:accu>>base)))
|
((equal? op ">>=") (wrap-as (i386:accu>>base)))
|
||||||
((equal? op "<<=") (wrap-as (i386:accu<<base)))
|
((equal? op "<<=") (wrap-as (i386:accu<<base)))
|
||||||
(else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))
|
(else (error (format #f "mescc: op ~a not supported: ~a\n" op o)))))))
|
||||||
(cond ((not (and (= rank 1) (= rank-b 1))) info)
|
(cond ((not (and (= rank 1) (= rank-b 1))) info)
|
||||||
((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
|
((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
|
||||||
(i386:accu/base)))))
|
(i386:accu/base)))))
|
||||||
(else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
|
(else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
|
||||||
(when (and (equal? op "=")
|
(when (and (equal? op "=")
|
||||||
(not (= size size-b))
|
(not (= size size-b))
|
||||||
(not (and (or (= size 1) (= size 2))
|
(not (and (or (= size 1) (= size 2))
|
||||||
(= size-b 4)))
|
(= size-b 4)))
|
||||||
(not (and (= size 2)
|
(not (and (= size 2)
|
||||||
(= size-b 4)))
|
(= size-b 4)))
|
||||||
(not (and (= size 4)
|
(not (and (= size 4)
|
||||||
(or (= size-b 1) (= size-b 2)))))
|
(or (= size-b 1) (= size-b 2)))))
|
||||||
(stderr "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o))))
|
(stderr "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o))))
|
||||||
(stderr " size[~a]:~a != size[~a]:~a\n" rank size rank-b size-b))
|
(stderr " size[~a]:~a != size[~a]:~a\n" rank size rank-b size-b))
|
||||||
(pmatch a
|
(pmatch a
|
||||||
((p-expr (ident ,name))
|
((p-expr (ident ,name))
|
||||||
(if (or (<= size 4) ;; FIXME: long long = int
|
(if (or (<= size 4) ;; FIXME: long long = int
|
||||||
(<= 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)))
|
||||||
(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))))
|
||||||
|
|
||||||
|
(let ((info (helper)))
|
||||||
|
(if (null? (.post info)) info
|
||||||
|
(append-text (clone info #:post '()) (.post info))))))
|
||||||
|
|
||||||
(define (expr->base o info)
|
(define (expr->base o info)
|
||||||
(let* ((info (append-text info (wrap-as (i386:push-accu))))
|
(let* ((info (append-text info (wrap-as (i386:push-accu))))
|
||||||
|
|
|
||||||
|
|
@ -40,6 +40,7 @@
|
||||||
.function
|
.function
|
||||||
.statics
|
.statics
|
||||||
.text
|
.text
|
||||||
|
.post
|
||||||
.break
|
.break
|
||||||
.continue
|
.continue
|
||||||
|
|
||||||
|
|
@ -114,7 +115,7 @@
|
||||||
(mes-use-module (mes optargs))))
|
(mes-use-module (mes optargs))))
|
||||||
|
|
||||||
(define-immutable-record-type <info>
|
(define-immutable-record-type <info>
|
||||||
(make-<info> types constants functions globals locals statics function text break continue)
|
(make-<info> types constants functions globals locals statics function text post break continue)
|
||||||
info?
|
info?
|
||||||
(types .types)
|
(types .types)
|
||||||
(constants .constants)
|
(constants .constants)
|
||||||
|
|
@ -124,11 +125,12 @@
|
||||||
(statics .statics)
|
(statics .statics)
|
||||||
(function .function)
|
(function .function)
|
||||||
(text .text)
|
(text .text)
|
||||||
|
(post .post)
|
||||||
(break .break)
|
(break .break)
|
||||||
(continue .continue))
|
(continue .continue))
|
||||||
|
|
||||||
(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (break '()) (continue '()))
|
(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()))
|
||||||
(make-<info> types constants functions globals locals statics function text break continue))
|
(make-<info> types constants functions globals locals statics function text post break continue))
|
||||||
|
|
||||||
;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
|
;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
|
||||||
;; (make-type 'enum 4 0 fields)
|
;; (make-type 'enum 4 0 fields)
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,39 @@
|
||||||
|
/* -*-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 foo {int length; char* string; struct foo *next;};
|
||||||
|
// struct foo stack[] = {{20, "foo", 0}, {4, "baaz", 0}, {0, 0, 0}};
|
||||||
|
|
||||||
|
struct info {int flag;};
|
||||||
|
struct foo {int length; char* string; struct info info;};
|
||||||
|
struct foo stack[] = {{3, "foo", {11}},{4, "baar", {12}}};
|
||||||
|
|
||||||
|
int
|
||||||
|
main ()
|
||||||
|
{
|
||||||
|
puts (stack[0].string); puts ("\n");
|
||||||
|
puts (stack[1].string); puts ("\n");
|
||||||
|
struct foo* top = &stack[1];
|
||||||
|
int i;
|
||||||
|
i = (top--)->info.flag;
|
||||||
|
top++;
|
||||||
|
int j = (--top)->info.flag;
|
||||||
|
return i - j - 1;
|
||||||
|
}
|
||||||
Loading…
Reference in New Issue