artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Tinycc support: Implement (foo--)->bar and permutations.

Browse source 
* 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 2018-05-13 13:50:32 +02:00
parent 330404125e
commit 057607ca0a
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
4 changed files with 451 additions and 343 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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

746
module/language/c99/compiler.mes
View file

@ -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))))

8
module/language/c99/info.scm
View file

@ -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)

39
scaffold/tests/7o-struct-pre-post.c Normal file
View file

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