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
|
||||
7m-struct-char-array-assign
|
||||
7n-struct-struct-array
|
||||
7o-struct-pre-post
|
||||
80-setjmp
|
||||
81-qsort
|
||||
82-define
|
||||
|
|
|
|||
|
|
@ -115,6 +115,7 @@
|
|||
(statics (.statics o))
|
||||
(function (.function o))
|
||||
(text (.text o))
|
||||
(post (.post o))
|
||||
(break (.break o))
|
||||
(continue (.continue o)))
|
||||
(let-keywords rest
|
||||
|
|
@ -127,9 +128,10 @@
|
|||
(statics statics)
|
||||
(function function)
|
||||
(text text)
|
||||
(post post)
|
||||
(break break)
|
||||
(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)
|
||||
(cons name value))
|
||||
|
|
@ -810,6 +812,66 @@
|
|||
(info (expr->base array info)))
|
||||
(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))))
|
||||
|
||||
(define (expr-add info)
|
||||
|
|
@ -820,392 +882,396 @@
|
|||
|
||||
(define (expr->accu o info)
|
||||
(let ((locals (.locals info))
|
||||
(constants (.constants info))
|
||||
(text (.text info))
|
||||
(globals (.globals info)))
|
||||
(pmatch o
|
||||
((expr) info)
|
||||
(define (helper)
|
||||
(pmatch o
|
||||
((expr) info)
|
||||
|
||||
((comma-expr) info)
|
||||
((comma-expr) info)
|
||||
|
||||
((comma-expr ,a . ,rest)
|
||||
(let ((info (expr->accu a info)))
|
||||
(expr->accu `(comma-expr ,@rest) info)))
|
||||
((comma-expr ,a . ,rest)
|
||||
(let ((info (expr->accu a info)))
|
||||
(expr->accu `(comma-expr ,@rest) info)))
|
||||
|
||||
((p-expr (string ,string))
|
||||
(let* ((globals ((globals:add-string globals) string))
|
||||
(info (clone info #:globals globals)))
|
||||
(append-text info (list (i386:label->accu `(#:string ,string))))))
|
||||
((p-expr (string ,string))
|
||||
(let* ((globals ((globals:add-string globals) string))
|
||||
(info (clone info #:globals globals)))
|
||||
(append-text info (list (i386:label->accu `(#:string ,string))))))
|
||||
|
||||
((p-expr (fixed ,value))
|
||||
(let ((value (cstring->number value)))
|
||||
(append-text info (wrap-as (i386:value->accu value)))))
|
||||
((p-expr (fixed ,value))
|
||||
(let ((value (cstring->number value)))
|
||||
(append-text info (wrap-as (i386:value->accu value)))))
|
||||
|
||||
((neg (p-expr (fixed ,value)))
|
||||
(let ((value (- (cstring->number value))))
|
||||
(append-text info (wrap-as (i386:value->accu value)))))
|
||||
((neg (p-expr (fixed ,value)))
|
||||
(let ((value (- (cstring->number value))))
|
||||
(append-text info (wrap-as (i386:value->accu value)))))
|
||||
|
||||
((p-expr (char ,char))
|
||||
(let ((char (char->integer (car (string->list char)))))
|
||||
(append-text info (wrap-as (i386:value->accu char)))))
|
||||
((p-expr (char ,char))
|
||||
(let ((char (char->integer (car (string->list char)))))
|
||||
(append-text info (wrap-as (i386:value->accu char)))))
|
||||
|
||||
((p-expr (string . ,strings))
|
||||
(append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
|
||||
((p-expr (string . ,strings))
|
||||
(append-text info (list (i386:label->accu `(#:string ,(apply string-append strings))))))
|
||||
|
||||
((p-expr (ident ,name))
|
||||
(append-text info ((ident->accu info) name)))
|
||||
((p-expr (ident ,name))
|
||||
(append-text info ((ident->accu info) name)))
|
||||
|
||||
((initzer ,initzer)
|
||||
(expr->accu initzer info))
|
||||
((initzer ,initzer)
|
||||
(expr->accu initzer info))
|
||||
|
||||
;; offsetoff
|
||||
((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))
|
||||
(offset (field-offset info type field))
|
||||
(base (cstring->number base)))
|
||||
(append-text info (wrap-as (i386:value->accu (+ base offset))))))
|
||||
;; offsetoff
|
||||
((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))
|
||||
(offset (field-offset info type field))
|
||||
(base (cstring->number base)))
|
||||
(append-text info (wrap-as (i386:value->accu (+ base offset))))))
|
||||
|
||||
;; &foo
|
||||
((ref-to (p-expr (ident ,name)))
|
||||
(append-text info ((ident-address->accu info) name)))
|
||||
;; &foo
|
||||
((ref-to (p-expr (ident ,name)))
|
||||
(append-text info ((ident-address->accu info) name)))
|
||||
|
||||
;; &*foo
|
||||
((ref-to (de-ref ,expr))
|
||||
(expr->accu expr info))
|
||||
;; &*foo
|
||||
((ref-to (de-ref ,expr))
|
||||
(expr->accu expr info))
|
||||
|
||||
((ref-to ,expr)
|
||||
(expr->accu* expr info))
|
||||
((ref-to ,expr)
|
||||
(expr->accu* expr info))
|
||||
|
||||
((sizeof-expr ,expr)
|
||||
(append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
|
||||
((sizeof-expr ,expr)
|
||||
(append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
|
||||
|
||||
((sizeof-type ,type)
|
||||
(append-text info (wrap-as (i386:value->accu (ast->size type info)))))
|
||||
((sizeof-type ,type)
|
||||
(append-text info (wrap-as (i386:value->accu (ast->size type info)))))
|
||||
|
||||
((array-ref ,index ,array)
|
||||
(let* ((info (expr->accu* o info))
|
||||
(size (ast->size o info)))
|
||||
(append-text info (wrap-as (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((2) (i386:word-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '()))))))
|
||||
((array-ref ,index ,array)
|
||||
(let* ((info (expr->accu* o info))
|
||||
(size (ast->size o info)))
|
||||
(append-text info (wrap-as (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((2) (i386:word-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '()))))))
|
||||
|
||||
((d-sel ,field ,struct)
|
||||
(let* ((info (expr->accu* o info))
|
||||
(info (append-text info (ast->comment o)))
|
||||
(type (ast->type o info))
|
||||
(size (->size type))
|
||||
(array? (c-array? type)))
|
||||
(if array? info
|
||||
(append-text info (wrap-as (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((2) (i386:word-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '())))))))
|
||||
((d-sel ,field ,struct)
|
||||
(let* ((info (expr->accu* o info))
|
||||
(info (append-text info (ast->comment o)))
|
||||
(type (ast->type o info))
|
||||
(size (->size type))
|
||||
(array? (c-array? type)))
|
||||
(if array? info
|
||||
(append-text info (wrap-as (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((2) (i386:word-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '())))))))
|
||||
|
||||
((i-sel ,field ,struct)
|
||||
(let* ((info (expr->accu* o info))
|
||||
(info (append-text info (ast->comment o)))
|
||||
(type (ast->type o info))
|
||||
(size (->size type))
|
||||
(array? (c-array? type)))
|
||||
(if array? info
|
||||
(append-text info (wrap-as (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((2) (i386:word-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '())))))))
|
||||
((i-sel ,field ,struct)
|
||||
(let* ((info (expr->accu* o info))
|
||||
(info (append-text info (ast->comment o)))
|
||||
(type (ast->type o info))
|
||||
(size (->size type))
|
||||
(array? (c-array? type)))
|
||||
(if array? info
|
||||
(append-text info (wrap-as (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((2) (i386:word-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '())))))))
|
||||
|
||||
((de-ref ,expr)
|
||||
(let* ((info (expr->accu expr info))
|
||||
(size (ast->size o info)))
|
||||
(append-text info (wrap-as (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((2) (i386:word-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '()))))))
|
||||
((de-ref ,expr)
|
||||
(let* ((info (expr->accu expr info))
|
||||
(size (ast->size o info)))
|
||||
(append-text info (wrap-as (case size
|
||||
((1) (i386:byte-mem->accu))
|
||||
((2) (i386:word-mem->accu))
|
||||
((4) (i386:mem->accu))
|
||||
(else '()))))))
|
||||
|
||||
((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
|
||||
(if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
|
||||
(append-text info (wrap-as (asm->m1 arg0))))
|
||||
(let* ((text-length (length text))
|
||||
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
||||
(if (null? expressions) info
|
||||
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
||||
(n (length expr-list)))
|
||||
(if (not (assoc-ref locals name))
|
||||
(begin
|
||||
(if (and (not (assoc name (.functions info)))
|
||||
(not (assoc name globals))
|
||||
(not (equal? name (.function info))))
|
||||
(stderr "warning: undeclared function: ~a\n" name))
|
||||
(append-text args-info (list (i386:call-label name n))))
|
||||
(let* ((empty (clone info #:text '()))
|
||||
(accu (expr->accu `(p-expr (ident ,name)) empty)))
|
||||
(append-text args-info (append (.text accu)
|
||||
(list (i386:call-accu n)))))))))
|
||||
((fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))
|
||||
(if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
|
||||
(append-text info (wrap-as (asm->m1 arg0))))
|
||||
(let* ((text-length (length text))
|
||||
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
||||
(if (null? expressions) info
|
||||
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
||||
(n (length expr-list)))
|
||||
(if (not (assoc-ref locals name))
|
||||
(begin
|
||||
(if (and (not (assoc name (.functions info)))
|
||||
(not (assoc name globals))
|
||||
(not (equal? name (.function info))))
|
||||
(stderr "warning: undeclared function: ~a\n" name))
|
||||
(append-text args-info (list (i386:call-label name n))))
|
||||
(let* ((empty (clone info #:text '()))
|
||||
(accu (expr->accu `(p-expr (ident ,name)) empty)))
|
||||
(append-text args-info (append (.text accu)
|
||||
(list (i386:call-accu n)))))))))
|
||||
|
||||
((fctn-call ,function (expr-list . ,expr-list))
|
||||
(let* ((text-length (length text))
|
||||
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
||||
(if (null? expressions) info
|
||||
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
||||
(n (length expr-list))
|
||||
(empty (clone info #:text '()))
|
||||
(accu (expr->accu function empty)))
|
||||
(append-text args-info (append (.text accu)
|
||||
(list (i386:call-accu n))))))
|
||||
((fctn-call ,function (expr-list . ,expr-list))
|
||||
(let* ((text-length (length text))
|
||||
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
||||
(if (null? expressions) info
|
||||
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
||||
(n (length expr-list))
|
||||
(empty (clone info #:text '()))
|
||||
(accu (expr->accu function empty)))
|
||||
(append-text args-info (append (.text accu)
|
||||
(list (i386:call-accu n))))))
|
||||
|
||||
((cond-expr . ,cond-expr)
|
||||
(ast->info `(expr-stmt ,o) info))
|
||||
((cond-expr . ,cond-expr)
|
||||
(ast->info `(expr-stmt ,o) info))
|
||||
|
||||
((post-inc ,expr)
|
||||
(let* ((info (append (expr->accu expr info)))
|
||||
(info (append-text info (wrap-as (i386:push-accu))))
|
||||
(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-text info (wrap-as (i386:pop-accu)))))
|
||||
info))
|
||||
((post-inc ,expr)
|
||||
(let* ((info (append (expr->accu expr info)))
|
||||
(info (append-text info (wrap-as (i386:push-accu))))
|
||||
(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-text info (wrap-as (i386:pop-accu)))))
|
||||
info))
|
||||
|
||||
((post-dec ,expr)
|
||||
(let* ((info (append (expr->accu expr info)))
|
||||
(info (append-text info (wrap-as (i386:push-accu))))
|
||||
(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-text info (wrap-as (i386:pop-accu)))))
|
||||
info))
|
||||
((post-dec ,expr)
|
||||
(let* ((info (append (expr->accu expr info)))
|
||||
(info (append-text info (wrap-as (i386:push-accu))))
|
||||
(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-text info (wrap-as (i386:pop-accu)))))
|
||||
info))
|
||||
|
||||
((pre-inc ,expr)
|
||||
(let* ((rank (expr->rank info expr))
|
||||
(size (cond ((= rank 1) (ast-type->size info expr))
|
||||
((> rank 1) 4)
|
||||
(else 1)))
|
||||
(info ((expr-add info) expr size))
|
||||
(info (append (expr->accu expr info))))
|
||||
info))
|
||||
((pre-inc ,expr)
|
||||
(let* ((rank (expr->rank info expr))
|
||||
(size (cond ((= rank 1) (ast-type->size info expr))
|
||||
((> rank 1) 4)
|
||||
(else 1)))
|
||||
(info ((expr-add info) expr size))
|
||||
(info (append (expr->accu expr info))))
|
||||
info))
|
||||
|
||||
((pre-dec ,expr)
|
||||
(let* ((rank (expr->rank info expr))
|
||||
(size (cond ((= rank 1) (ast-type->size info expr))
|
||||
((> rank 1) 4)
|
||||
(else 1)))
|
||||
(info ((expr-add info) expr (- size)))
|
||||
(info (append (expr->accu expr info))))
|
||||
info))
|
||||
((pre-dec ,expr)
|
||||
(let* ((rank (expr->rank info expr))
|
||||
(size (cond ((= rank 1) (ast-type->size info expr))
|
||||
((> rank 1) 4)
|
||||
(else 1)))
|
||||
(info ((expr-add info) expr (- size)))
|
||||
(info (append (expr->accu expr info))))
|
||||
info))
|
||||
|
||||
|
||||
|
||||
((add ,a (p-expr (fixed ,value)))
|
||||
(let* ((rank (expr->rank info a))
|
||||
(type (ast->basic-type a info))
|
||||
(struct? (structured-type? type))
|
||||
(size (cond ((= rank 1) (ast-type->size info a))
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1)))
|
||||
(info (expr->accu a info))
|
||||
(value (cstring->number value))
|
||||
(value (* size value)))
|
||||
(append-text info (wrap-as (i386:accu+value value)))))
|
||||
((add ,a (p-expr (fixed ,value)))
|
||||
(let* ((rank (expr->rank info a))
|
||||
(type (ast->basic-type a info))
|
||||
(struct? (structured-type? type))
|
||||
(size (cond ((= rank 1) (ast-type->size info a))
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1)))
|
||||
(info (expr->accu a info))
|
||||
(value (cstring->number value))
|
||||
(value (* size value)))
|
||||
(append-text info (wrap-as (i386:accu+value value)))))
|
||||
|
||||
((add ,a ,b)
|
||||
(let* ((rank (expr->rank info a))
|
||||
(rank-b (expr->rank info b))
|
||||
(type (ast->basic-type a info))
|
||||
(struct? (structured-type? type))
|
||||
(size (cond ((= rank 1) (ast-type->size info a))
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1))))
|
||||
(if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
|
||||
(let* ((info (expr->accu b info))
|
||||
(info (append-text info (wrap-as (append (i386:value->base size)
|
||||
(i386:accu*base)
|
||||
(i386:accu->base)))))
|
||||
(info (expr->accu a info)))
|
||||
(append-text info (wrap-as (i386:accu+base)))))))
|
||||
((add ,a ,b)
|
||||
(let* ((rank (expr->rank info a))
|
||||
(rank-b (expr->rank info b))
|
||||
(type (ast->basic-type a info))
|
||||
(struct? (structured-type? type))
|
||||
(size (cond ((= rank 1) (ast-type->size info a))
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1))))
|
||||
(if (or (= size 1)) ((binop->accu info) a b (i386:accu+base))
|
||||
(let* ((info (expr->accu b info))
|
||||
(info (append-text info (wrap-as (append (i386:value->base size)
|
||||
(i386:accu*base)
|
||||
(i386:accu->base)))))
|
||||
(info (expr->accu a info)))
|
||||
(append-text info (wrap-as (i386:accu+base)))))))
|
||||
|
||||
((sub ,a (p-expr (fixed ,value)))
|
||||
(let* ((rank (expr->rank info a))
|
||||
(type (ast->basic-type a info))
|
||||
(struct? (structured-type? type))
|
||||
(size (->size type))
|
||||
(size (cond ((= rank 1) size)
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1)))
|
||||
(info (expr->accu a info))
|
||||
(value (cstring->number value))
|
||||
(value (* size value)))
|
||||
(append-text info (wrap-as (i386:accu+value (- value))))))
|
||||
((sub ,a (p-expr (fixed ,value)))
|
||||
(let* ((rank (expr->rank info a))
|
||||
(type (ast->basic-type a info))
|
||||
(struct? (structured-type? type))
|
||||
(size (->size type))
|
||||
(size (cond ((= rank 1) size)
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1)))
|
||||
(info (expr->accu a info))
|
||||
(value (cstring->number value))
|
||||
(value (* size value)))
|
||||
(append-text info (wrap-as (i386:accu+value (- value))))))
|
||||
|
||||
((sub ,a ,b)
|
||||
(let* ((rank (expr->rank info a))
|
||||
(rank-b (expr->rank info b))
|
||||
(type (ast->basic-type a info))
|
||||
(struct? (structured-type? type))
|
||||
(size (->size type))
|
||||
(size (cond ((= rank 1) size)
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1))))
|
||||
(if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
|
||||
(let ((info ((binop->accu info) a b (i386:accu-base))))
|
||||
(if (and (not (= rank-b 2)) (not (= rank-b 1))) info
|
||||
(append-text info (wrap-as (append (i386:value->base size)
|
||||
(i386:accu/base))))))
|
||||
(let* ((info (expr->accu b info))
|
||||
(info (append-text info (wrap-as (append (i386:value->base size)
|
||||
(i386:accu*base)
|
||||
(i386:accu->base)))))
|
||||
(info (expr->accu a info)))
|
||||
(append-text info (wrap-as (i386:accu-base)))))))
|
||||
((sub ,a ,b)
|
||||
(let* ((rank (expr->rank info a))
|
||||
(rank-b (expr->rank info b))
|
||||
(type (ast->basic-type a info))
|
||||
(struct? (structured-type? type))
|
||||
(size (->size type))
|
||||
(size (cond ((= rank 1) size)
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1))))
|
||||
(if (or (= size 1) (or (= rank-b 2) (= rank-b 1)))
|
||||
(let ((info ((binop->accu info) a b (i386:accu-base))))
|
||||
(if (and (not (= rank-b 2)) (not (= rank-b 1))) info
|
||||
(append-text info (wrap-as (append (i386:value->base size)
|
||||
(i386:accu/base))))))
|
||||
(let* ((info (expr->accu b info))
|
||||
(info (append-text info (wrap-as (append (i386:value->base size)
|
||||
(i386:accu*base)
|
||||
(i386:accu->base)))))
|
||||
(info (expr->accu a info)))
|
||||
(append-text info (wrap-as (i386:accu-base)))))))
|
||||
|
||||
((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
|
||||
((bitwise-not ,expr)
|
||||
(let ((info (ast->info expr info)))
|
||||
(append-text info (wrap-as (i386:accu-not)))))
|
||||
((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)))
|
||||
((lshift ,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)))
|
||||
((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
|
||||
((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
|
||||
((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
|
||||
((bitwise-not ,expr)
|
||||
(let ((info (ast->info expr info)))
|
||||
(append-text info (wrap-as (i386:accu-not)))))
|
||||
((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)))
|
||||
((lshift ,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)))
|
||||
((mod ,a ,b) ((binop->accu info) a b (i386:accu%base)))
|
||||
((mul ,a ,b) ((binop->accu info) a b (i386:accu*base)))
|
||||
|
||||
((not ,expr)
|
||||
(let* ((test-info (ast->info expr info)))
|
||||
(clone info #:text
|
||||
(append (.text test-info)
|
||||
(wrap-as (i386:accu-negate)))
|
||||
#:globals (.globals test-info))))
|
||||
((not ,expr)
|
||||
(let* ((test-info (ast->info expr info)))
|
||||
(clone info #:text
|
||||
(append (.text test-info)
|
||||
(wrap-as (i386:accu-negate)))
|
||||
#:globals (.globals test-info))))
|
||||
|
||||
((neg ,expr)
|
||||
(let ((info (expr->base expr info)))
|
||||
(append-text info (append (wrap-as (i386:value->accu 0))
|
||||
(wrap-as (i386:sub-base))))))
|
||||
((neg ,expr)
|
||||
(let ((info (expr->base expr info)))
|
||||
(append-text info (append (wrap-as (i386:value->accu 0))
|
||||
(wrap-as (i386:sub-base))))))
|
||||
|
||||
((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))))
|
||||
((gt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:g?->accu) (i386:accu-test))))
|
||||
((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))))
|
||||
((gt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:g?->accu) (i386:accu-test))))
|
||||
|
||||
;; FIXME: set accu *and* flags
|
||||
((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
|
||||
(i386:sub-base)
|
||||
(i386:nz->accu)
|
||||
(i386:accu<->stack)
|
||||
(i386:sub-base)
|
||||
(i386:xor-zf)
|
||||
(i386:pop-accu))))
|
||||
;; FIXME: set accu *and* flags
|
||||
((ne ,a ,b) ((binop->accu info) a b (append (i386:push-accu)
|
||||
(i386:sub-base)
|
||||
(i386:nz->accu)
|
||||
(i386:accu<->stack)
|
||||
(i386:sub-base)
|
||||
(i386:xor-zf)
|
||||
(i386:pop-accu))))
|
||||
|
||||
((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))))
|
||||
((lt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:l?->accu))))
|
||||
((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))))
|
||||
((lt ,a ,b) ((binop->accu info) a b (append (i386:sub-base) (i386:l?->accu))))
|
||||
|
||||
((or ,a ,b)
|
||||
(let* ((info (expr->accu a info))
|
||||
(here (number->string (length (.text info))))
|
||||
(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:jump-nz skip-b-label))))
|
||||
(info (append-text info (wrap-as (i386:accu-test))))
|
||||
(info (expr->accu b info))
|
||||
(info (append-text info (wrap-as (i386:accu-test))))
|
||||
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
||||
info))
|
||||
((or ,a ,b)
|
||||
(let* ((info (expr->accu a info))
|
||||
(here (number->string (length (.text info))))
|
||||
(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:jump-nz skip-b-label))))
|
||||
(info (append-text info (wrap-as (i386:accu-test))))
|
||||
(info (expr->accu b info))
|
||||
(info (append-text info (wrap-as (i386:accu-test))))
|
||||
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
||||
info))
|
||||
|
||||
((and ,a ,b)
|
||||
(let* ((info (expr->accu a info))
|
||||
(here (number->string (length (.text info))))
|
||||
(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:jump-z skip-b-label))))
|
||||
(info (append-text info (wrap-as (i386:accu-test))))
|
||||
(info (expr->accu b info))
|
||||
(info (append-text info (wrap-as (i386:accu-test))))
|
||||
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
||||
info))
|
||||
((and ,a ,b)
|
||||
(let* ((info (expr->accu a info))
|
||||
(here (number->string (length (.text info))))
|
||||
(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:jump-z skip-b-label))))
|
||||
(info (append-text info (wrap-as (i386:accu-test))))
|
||||
(info (expr->accu b info))
|
||||
(info (append-text info (wrap-as (i386:accu-test))))
|
||||
(info (append-text info (wrap-as `((#:label ,skip-b-label))))))
|
||||
info))
|
||||
|
||||
((cast ,type ,expr)
|
||||
(expr->accu expr info))
|
||||
((cast ,type ,expr)
|
||||
(expr->accu expr info))
|
||||
|
||||
((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))
|
||||
(type (ident->type info name))
|
||||
(rank (ident->rank info name))
|
||||
(size (if (> rank 1) 4 1)))
|
||||
(append-text info ((ident-add info) name size))))
|
||||
((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))
|
||||
(type (ident->type info name))
|
||||
(rank (ident->rank info name))
|
||||
(size (if (> rank 1) 4 1)))
|
||||
(append-text info ((ident-add info) name size))))
|
||||
|
||||
((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))
|
||||
(type (ident->type info name))
|
||||
(rank (ident->rank info name))
|
||||
(size (if (> rank 1) 4 1)))
|
||||
(append-text info ((ident-add info) name (- size)))))
|
||||
((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))
|
||||
(type (ident->type info name))
|
||||
(rank (ident->rank info name))
|
||||
(size (if (> rank 1) 4 1)))
|
||||
(append-text info ((ident-add info) name (- size)))))
|
||||
|
||||
((assn-expr ,a (op ,op) ,b)
|
||||
(let* ((info (append-text info (ast->comment o)))
|
||||
(type (ast->type a info))
|
||||
(rank (->rank type))
|
||||
(type-b (ast->type b info))
|
||||
(rank-b (->rank type-b))
|
||||
(size (->size type))
|
||||
(size-b (->size type-b))
|
||||
(info (expr->accu b info))
|
||||
(info (if (equal? op "=") info
|
||||
(let* ((struct? (structured-type? type))
|
||||
(size (cond ((= rank 1) (ast-type->size info a))
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1)))
|
||||
(info (if (or (= size 1) (= rank-b 1)) info
|
||||
(let ((info (append-text info (wrap-as (i386:value->base size)))))
|
||||
(append-text info (wrap-as (i386:accu*base))))))
|
||||
(info (append-text info (wrap-as (i386:push-accu))))
|
||||
(info (expr->accu a info))
|
||||
(info (append-text info (wrap-as (i386:pop-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-and-base)))
|
||||
((equal? op "|=") (wrap-as (i386:accu-or-base)))
|
||||
((equal? op "^=") (wrap-as (i386:accu-xor-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)))))))
|
||||
(cond ((not (and (= rank 1) (= rank-b 1))) info)
|
||||
((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
|
||||
(i386:accu/base)))))
|
||||
(else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
|
||||
(when (and (equal? op "=")
|
||||
(not (= size size-b))
|
||||
(not (and (or (= size 1) (= size 2))
|
||||
(= size-b 4)))
|
||||
(not (and (= size 2)
|
||||
(= size-b 4)))
|
||||
(not (and (= size 4)
|
||||
(or (= size-b 1) (= size-b 2)))))
|
||||
(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))
|
||||
(pmatch a
|
||||
((p-expr (ident ,name))
|
||||
(if (or (<= size 4) ;; FIXME: long long = int
|
||||
(<= size-b 4)) (append-text info ((accu->ident info) name))
|
||||
(let ((info (expr->base* a info)))
|
||||
(accu->base-mem*n info size))))
|
||||
(_ (let ((info (expr->base* a info)))
|
||||
(accu->base-mem*n info (min size (max 4 size-b)))))))) ;; FIXME: long long = int
|
||||
((assn-expr ,a (op ,op) ,b)
|
||||
(let* ((info (append-text info (ast->comment o)))
|
||||
(type (ast->type a info))
|
||||
(rank (->rank type))
|
||||
(type-b (ast->type b info))
|
||||
(rank-b (->rank type-b))
|
||||
(size (->size type))
|
||||
(size-b (->size type-b))
|
||||
(info (expr->accu b info))
|
||||
(info (if (equal? op "=") info
|
||||
(let* ((struct? (structured-type? type))
|
||||
(size (cond ((= rank 1) (ast-type->size info a))
|
||||
((> rank 1) 4)
|
||||
((and struct? (= rank 2)) 4)
|
||||
(else 1)))
|
||||
(info (if (or (= size 1) (= rank-b 1)) info
|
||||
(let ((info (append-text info (wrap-as (i386:value->base size)))))
|
||||
(append-text info (wrap-as (i386:accu*base))))))
|
||||
(info (append-text info (wrap-as (i386:push-accu))))
|
||||
(info (expr->accu a info))
|
||||
(info (append-text info (wrap-as (i386:pop-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-and-base)))
|
||||
((equal? op "|=") (wrap-as (i386:accu-or-base)))
|
||||
((equal? op "^=") (wrap-as (i386:accu-xor-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)))))))
|
||||
(cond ((not (and (= rank 1) (= rank-b 1))) info)
|
||||
((equal? op "-=") (append-text info (wrap-as (append (i386:value->base size)
|
||||
(i386:accu/base)))))
|
||||
(else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
|
||||
(when (and (equal? op "=")
|
||||
(not (= size size-b))
|
||||
(not (and (or (= size 1) (= size 2))
|
||||
(= size-b 4)))
|
||||
(not (and (= size 2)
|
||||
(= size-b 4)))
|
||||
(not (and (= size 4)
|
||||
(or (= size-b 1) (= size-b 2)))))
|
||||
(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))
|
||||
(pmatch a
|
||||
((p-expr (ident ,name))
|
||||
(if (or (<= size 4) ;; FIXME: long long = int
|
||||
(<= size-b 4)) (append-text info ((accu->ident info) name))
|
||||
(let ((info (expr->base* a info)))
|
||||
(accu->base-mem*n info size))))
|
||||
(_ (let ((info (expr->base* a info)))
|
||||
(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)
|
||||
(let* ((info (append-text info (wrap-as (i386:push-accu))))
|
||||
|
|
|
|||
|
|
@ -40,6 +40,7 @@
|
|||
.function
|
||||
.statics
|
||||
.text
|
||||
.post
|
||||
.break
|
||||
.continue
|
||||
|
||||
|
|
@ -114,7 +115,7 @@
|
|||
(mes-use-module (mes optargs))))
|
||||
|
||||
(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?
|
||||
(types .types)
|
||||
(constants .constants)
|
||||
|
|
@ -124,11 +125,12 @@
|
|||
(statics .statics)
|
||||
(function .function)
|
||||
(text .text)
|
||||
(post .post)
|
||||
(break .break)
|
||||
(continue .continue))
|
||||
|
||||
(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (break '()) (continue '()))
|
||||
(make-<info> types constants functions globals locals statics function 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 post break continue))
|
||||
|
||||
;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
|
||||
;; (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