mescc: Prepare for x86_64 support.

* module/mescc/info.scm (info): Add allocated, registers.
* module/mescc/i386/info.scm: New file.
* build-aux/build-guile.sh (SCM_FILES): Add it.
* module/mescc/compile.scm (c99-input->info): Add info parameter.
(c99-ast->info): Likewise.
(i386:type-alist): Remove.
(alloc-register, free-register): New function.
(expr->register*): Rename from expr->accu*.  Update callers.
(expr->accu): Rename from expr->accu.  Update callers.
* module/mescc/mescc.scm(%info): New variable.
* module/mescc/mescc.scm (c->ast): Use it.
(mescc:compile): Likewise.
(E->info): Likewise.
This commit is contained in:
Jan Nieuwenhuizen 2018-08-14 12:35:24 +02:00
parent 92aad1ceaf
commit ee9081f3ec
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
6 changed files with 195 additions and 136 deletions

View File

@ -38,6 +38,7 @@ ${srcdest}module/mescc/as.scm
${srcdest}module/mescc/bytevectors.scm
${srcdest}module/mescc/compile.scm
${srcdest}module/mescc/i386/as.scm
${srcdest}module/mescc/i386/info.scm
${srcdest}module/mescc/info.scm
${srcdest}module/mescc/mescc.scm
${srcdest}module/mescc/preprocess.scm

View File

@ -43,13 +43,13 @@
(define mes? (pair? (current-module)))
(define* (c99-input->info #:key (prefix "") (defines '()) (includes '()))
(define* (c99-input->info info #:key (prefix "") (defines '()) (includes '()))
(let ((ast (c99-input->ast #:prefix prefix #:defines defines #:includes includes)))
(c99-ast->info ast)))
(c99-ast->info info ast)))
(define* (c99-ast->info o)
(define* (c99-ast->info info o)
(stderr "compiling: input\n")
(let ((info (ast->info o (make <info> #:types i386:type-alist))))
(let ((info (ast->info o info)))
(clean-info info)))
(define (clean-info o)
@ -74,41 +74,6 @@
(let ((size (apply max (map (compose ->size cdr) fields))))
(cons `(tag ,name) (make-type 'union size fields))))
(define i386:type-alist
`(("char" . ,(make-type 'signed 1 #f))
("short" . ,(make-type 'signed 2 #f))
("int" . ,(make-type 'signed 4 #f))
("long" . ,(make-type 'signed 4 #f))
("default" . ,(make-type 'signed 4 #f))
;;("long long" . ,(make-type 'signed 8 #f))
;;("long long int" . ,(make-type 'signed 8 #f))
("long long" . ,(make-type 'signed 4 #f)) ;; FIXME
("long long int" . ,(make-type 'signed 4 #f))
("void" . ,(make-type 'void 1 #f))
;; FIXME sign
("unsigned char" . ,(make-type 'unsigned 1 #f))
("unsigned short" . ,(make-type 'unsigned 2 #f))
("unsigned" . ,(make-type 'unsigned 4 #f))
("unsigned int" . ,(make-type 'unsigned 4 #f))
("unsigned long" . ,(make-type 'unsigned 4 #f))
;; ("unsigned long long" . ,(make-type 'builtin 8 #f))
;; ("unsigned long long int" . ,(make-type 'builtin 8 #f))
("unsigned long long" . ,(make-type 'unsigned 4 #f)) ;; FIXME
("unsigned long long int" . ,(make-type 'unsigned 4 #f))
("float" . ,(make-type 'float 4 #f))
("double" . ,(make-type 'float 8 #f))
("long double" . ,(make-type 'float 16 #f))
;;
("short int" . ,(make-type 'signed 2 #f))
("unsigned short int" . ,(make-type 'unsigned 2 #f))
("long int" . ,(make-type 'signed 4 #f))
("unsigned long int" . ,(make-type 'unsigned 4 #f))))
(define (signed? o)
(eq? ((compose type:type ->type) o) 'signed))
@ -552,7 +517,7 @@
(let* ((globals ((globals:add-string (.globals info)) string))
(info (clone info #:globals globals)))
(append-text info ((push-global-address info) `(#:string ,string)))))
(_ (let ((info (expr->accu o info)))
(_ (let ((info (expr->register o info)))
(append-text info (wrap-as (i386:push-accu))))))))
(define (globals:add-string globals)
@ -739,43 +704,55 @@
(define (accu->base-mem*n info n)
(append-text info (accu->base-mem*n- info n)))
(define (expr->accu* o info)
(define (alloc-register info)
(let ((registers (.registers info)))
(stderr " =>register: ~a\n" (car registers))
(clone info #:allocated (cons (car registers) (.allocated info)) #:registers (cdr registers))))
(define (free-register info)
(let ((allocated (.allocated info)))
(stderr " <=register: ~a\n" (car allocated))
(clone info #:allocated (cdr allocated) #:registers (cons (car allocated) (.registers info)))))
(define (expr->register* o info)
(pmatch o
((p-expr (ident ,name))
(append-text info ((ident-address->accu info) name)))
(let ((info (alloc-register info)))
(append-text info ((ident-address->accu info) name))))
((de-ref ,expr)
(expr->accu expr info))
(expr->register expr info))
((d-sel (ident ,field) ,struct)
(let* ((type (ast->basic-type struct info))
(offset (field-offset info type field))
(info (expr->accu* struct info)))
(info (expr->register* struct info)))
(append-text info (wrap-as (i386:accu+value offset)))))
((i-sel (ident ,field) (fctn-call (p-expr (ident ,function)) . ,rest))
(let* ((type (ast->basic-type `(fctn-call (p-expr (ident ,function)) ,@rest) info))
(offset (field-offset info type field))
(info (expr->accu `(fctn-call (p-expr (ident ,function)) ,@rest) info)))
(info (expr->register `(fctn-call (p-expr (ident ,function)) ,@rest) info)))
(append-text info (wrap-as (i386:accu+value offset)))))
((i-sel (ident ,field) ,struct)
(let* ((type (ast->basic-type struct info))
(offset (field-offset info type field))
(info (expr->accu* struct info)))
(info (expr->register* struct info)))
(append-text info (append (wrap-as (i386:mem->accu))
(wrap-as (i386:accu+value offset))))))
((array-ref ,index ,array)
(let* ((info (expr->accu index info))
(let* ((info (expr->register index info))
(size (ast->size o info))
(info (accu*n info size))
(info (expr->base array info)))
(append-text info (wrap-as (i386:accu+base)))))
((cast ,type ,expr)
(expr->accu `(ref-to ,expr) info))
(expr->register `(ref-to ,expr) info))
((add ,a ,b)
(let* ((rank (expr->rank info a))
@ -787,11 +764,11 @@
((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))
(let* ((info (expr->register b info))
(info (append-text info (wrap-as (append (i386:value->base size)
(i386:accu*base)
(i386:accu->base)))))
(info (expr->accu* a info)))
(info (expr->register* a info)))
(append-text info (wrap-as (i386:accu+base)))))))
((sub ,a ,b)
@ -809,11 +786,11 @@
(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))
(let* ((info (expr->register* b info))
(info (append-text info (wrap-as (append (i386:value->base size)
(i386:accu*base)
(i386:accu->base)))))
(info (expr->accu* a info)))
(info (expr->register* a info)))
(append-text info (wrap-as (i386:accu-base)))))))
((pre-dec ,expr)
@ -822,7 +799,7 @@
((> rank 1) 4)
(else 1)))
(info ((expr-add info) expr (- size)))
(info (append (expr->accu* expr info))))
(info (append (expr->register* expr info))))
info))
((pre-inc ,expr)
@ -831,11 +808,11 @@
((> rank 1) 4)
(else 1)))
(info ((expr-add info) expr size))
(info (append (expr->accu* expr info))))
(info (append (expr->register* expr info))))
info))
((post-dec ,expr)
(let* ((info (expr->accu* expr info))
(let* ((info (expr->register* expr info))
(info (append-text info (wrap-as (i386:push-accu))))
(post (clone info #:text '()))
(post (append-text post (ast->comment o)))
@ -851,7 +828,7 @@
(clone info #:post (.text post))))
((post-inc ,expr)
(let* ((info (expr->accu* expr info))
(let* ((info (expr->register* expr info))
(info (append-text info (wrap-as (i386:push-accu))))
(post (clone info #:text '()))
(post (append-text post (ast->comment o)))
@ -866,18 +843,21 @@
(post (append-text post (wrap-as (i386:pop-accu)))))
(clone info #:post (.text post))))
(_ (error "expr->accu*: not supported: " o))))
(_ (error "expr->register*: not supported: " o))))
(define (expr-add info)
(lambda (o n)
(let* ((info (expr->accu* o info))
(let* ((info (expr->register* o info))
(info (append-text info (wrap-as (i386:accu-mem-add n)))))
info)))
(define (expr->accu o info)
(define (expr->register o info)
(stderr "expr->register o=~s\n" o)
(let ((locals (.locals info))
(text (.text info))
(globals (.globals info)))
(define (helper)
(pmatch o
((expr) info)
@ -885,8 +865,8 @@
((comma-expr) info)
((comma-expr ,a . ,rest)
(let ((info (expr->accu a info)))
(expr->accu `(comma-expr ,@rest) info)))
(let ((info (expr->register a info)))
(expr->register `(comma-expr ,@rest) info)))
((p-expr (string ,string))
(let* ((globals ((globals:add-string globals) string))
@ -900,7 +880,8 @@
(append-text info (list (i386:label->accu `(#:string ,string))))))
((p-expr (fixed ,value))
(let ((value (cstring->int value)))
(let ((value (cstring->int value))
(info (alloc-register info)))
(append-text info (wrap-as (i386:value->accu value)))))
((p-expr (float ,value))
@ -921,10 +902,10 @@
(append-text info ((ident->accu info) name)))
((initzer ,initzer)
(expr->accu initzer info))
(expr->register initzer info))
(((initzer ,initzer))
(expr->accu initzer info))
(expr->register initzer info))
;; offsetoff
((ref-to (i-sel (ident ,field) (cast (type-name (decl-spec-list ,struct) (abs-declr (pointer))) (p-expr (fixed ,base)))))
@ -939,10 +920,10 @@
;; &*foo
((ref-to (de-ref ,expr))
(expr->accu expr info))
(expr->register expr info))
((ref-to ,expr)
(expr->accu* expr info))
(expr->register* expr info))
((sizeof-expr ,expr)
(append-text info (wrap-as (i386:value->accu (ast->size expr info)))))
@ -951,12 +932,12 @@
(append-text info (wrap-as (i386:value->accu (ast->size type info)))))
((array-ref ,index ,array)
(let* ((info (expr->accu* o info))
(let* ((info (expr->register* o info))
(type (ast->type o info)))
(append-text info (mem->accu type))))
((d-sel ,field ,struct)
(let* ((info (expr->accu* o info))
(let* ((info (expr->register* o info))
(info (append-text info (ast->comment o)))
(type (ast->type o info))
(size (->size type))
@ -965,7 +946,7 @@
(append-text info (mem->accu type)))))
((i-sel ,field ,struct)
(let* ((info (expr->accu* o info))
(let* ((info (expr->register* o info))
(info (append-text info (ast->comment o)))
(type (ast->type o info))
(size (->size type))
@ -974,7 +955,7 @@
(append-text info (mem->accu type)))))
((de-ref ,expr)
(let* ((info (expr->accu expr info))
(let* ((info (expr->register expr info))
(type (ast->type o info)))
(append-text info (mem->accu type))))
@ -994,7 +975,7 @@
(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)))
(accu (expr->register `(p-expr (ident ,name)) empty)))
(append-text args-info (append (.text accu)
(list (i386:call-accu n)))))))))
@ -1005,7 +986,7 @@
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
(n (length expr-list))
(empty (clone info #:text '()))
(accu (expr->accu function empty)))
(accu (expr->register function empty)))
(append-text args-info (append (.text accu)
(list (i386:call-accu n))))))
@ -1013,7 +994,7 @@
(ast->info `(expr-stmt ,o) info))
((post-inc ,expr)
(let* ((info (append (expr->accu expr info)))
(let* ((info (append (expr->register 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))
@ -1024,7 +1005,7 @@
info))
((post-dec ,expr)
(let* ((info (append (expr->accu expr info)))
(let* ((info (append (expr->register 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))
@ -1040,7 +1021,7 @@
((> rank 1) 4)
(else 1)))
(info ((expr-add info) expr size))
(info (append (expr->accu expr info))))
(info (append (expr->register expr info))))
info))
((pre-dec ,expr)
@ -1049,7 +1030,7 @@
((> rank 1) 4)
(else 1)))
(info ((expr-add info) expr (- size)))
(info (append (expr->accu expr info))))
(info (append (expr->register expr info))))
info))
@ -1062,7 +1043,7 @@
((> rank 1) 4)
((and struct? (= rank 2)) 4)
(else 1)))
(info (expr->accu a info))
(info (expr->register a info))
(value (cstring->int value))
(value (* size value)))
(append-text info (wrap-as (i386:accu+value value)))))
@ -1077,11 +1058,11 @@
((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))
(let* ((info (expr->register b info))
(info (append-text info (wrap-as (append (i386:value->base size)
(i386:accu*base)
(i386:accu->base)))))
(info (expr->accu a info)))
(info (expr->register a info)))
(append-text info (wrap-as (i386:accu+base)))))))
((sub ,a (p-expr (fixed ,value)))
@ -1093,7 +1074,7 @@
((> rank 1) 4)
((and struct? (= rank 2)) 4)
(else 1)))
(info (expr->accu a info))
(info (expr->register a info))
(value (cstring->int value))
(value (* size value)))
(append-text info (wrap-as (i386:accu+value (- value))))))
@ -1113,11 +1094,11 @@
(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))
(let* ((info (expr->register b info))
(info (append-text info (wrap-as (append (i386:value->base size)
(i386:accu*base)
(i386:accu->base)))))
(info (expr->accu a info)))
(info (expr->register a info)))
(append-text info (wrap-as (i386:accu-base)))))))
((bitwise-and ,a ,b) ((binop->accu info) a b (i386:accu-and-base)))
@ -1182,49 +1163,50 @@
((binop->accu info) a b (append (i386:sub-base) (test->accu) (i386:accu-test)))))
((or ,a ,b)
(let* ((info (expr->accu a info))
(let* ((info (expr->register 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 (expr->register 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))
(let* ((info (expr->register 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 (expr->register 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)
(let ((info (expr->accu expr info))
(let ((info (expr->register expr info))
(type (ast->type o info)))
(append-text info (convert-accu type))))
((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->register `(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))
(let* ((info (expr->register `(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)
(stderr "ASSN!\n")
(let* ((info (append-text info (ast->comment o)))
(type (ast->type a info))
(rank (->rank type))
@ -1232,7 +1214,7 @@
(rank-b (->rank type-b))
(size (if (zero? rank) (->size type) 4))
(size-b (if (zero? rank-b) (->size type-b) 4))
(info (expr->accu b info))
(info (expr->register b info))
(info (if (equal? op "=") info
(let* ((struct? (structured-type? type))
(size (cond ((= rank 1) (ast-type->size info a))
@ -1243,7 +1225,7 @@
(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 (expr->register 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)))
@ -1270,12 +1252,15 @@
(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))
(stderr " assign a=~s\n" a)
(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))
(info (accu->base-mem*n info size)))
;;???
(free-register info))))
(_ (let* ((info (expr->base* a info))
(info (if (not (bit-field? type)) info
(let* ((bit (bit-field:bit type))
@ -1299,7 +1284,7 @@
info))))
(accu->base-mem*n info (min size (max 4 size-b)))))))) ;; FIXME: long long = int
(_ (error "expr->accu: not supported: " o))))
(_ (error "expr->register: not supported: " o))))
(let ((info (helper)))
(if (null? (.post info)) info
@ -1329,19 +1314,19 @@
(define (expr->base o info)
(let* ((info (append-text info (wrap-as (i386:push-accu))))
(info (expr->accu o info))
(info (expr->register o info))
(info (append-text info (wrap-as (append (i386:accu->base) (i386:pop-accu))))))
info))
(define (binop->accu info)
(lambda (a b c)
(let* ((info (expr->accu a info))
(let* ((info (expr->register a info))
(info (expr->base b info)))
(append-text info (wrap-as c)))))
(define (binop->accu* info)
(lambda (a b c)
(let* ((info (expr->accu* a info))
(let* ((info (expr->register* a info))
(info (expr->base b info)))
(append-text info (wrap-as c)))))
@ -1350,7 +1335,7 @@
(define (expr->base* o info)
(let* ((info (append-text info (wrap-as (i386:push-accu))))
(info (expr->accu* o info))
(info (expr->register* o info))
(info (append-text info (wrap-as (i386:accu->base))))
(info (append-text info (wrap-as (i386:pop-accu)))))
info))
@ -1538,6 +1523,7 @@
(_ (error "ptr-declr->rank not supported: " o))))
(define (ast->info o info)
(stderr "ast->info o=~s\n" o)
(let ((functions (.functions info))
(globals (.globals info))
(locals (.locals info))
@ -1576,7 +1562,7 @@
(if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list))))
(append-text info (wrap-as (asm->m1 arg0))))
(let* ((info (append-text info (ast->comment o)))
(info (expr->accu `(fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) info)))
(info (expr->register `(fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)) info)))
(append-text info (wrap-as (i386:accu-zero?))))))
((if ,test ,then)
@ -1640,7 +1626,7 @@
(here (number->string (length text)))
(label (string-append "_" (.function info) "_" here "_"))
(break-label (string-append label "break"))
(info (expr->accu expr info))
(info (expr->register expr info))
(info (clone info #:break (cons break-label (.break info))))
(count (length (filter clause? statements)))
(default? (find (cut eq? <> 'default) (map clause? statements)))
@ -1673,7 +1659,7 @@
(info (append-text info (wrap-as `((#:label ,loop-label)))))
(info (ast->info body info))
(info (append-text info (wrap-as `((#:label ,continue-label)))))
(info (expr->accu step info))
(info (expr->register step info))
(info (append-text info (wrap-as `((#:label ,initial-skip-label)))))
(info ((test-jump-label->info info break-label) test))
(info (append-text info (wrap-as (i386:jump loop-label))))
@ -1732,7 +1718,7 @@
(append-text info (wrap-as (i386:jump (string-append "_" (.function info) "_label_" label)))))
((return ,expr)
(let ((info (expr->accu expr info)))
(let ((info (expr->register expr info)))
(append-text info (append (wrap-as (i386:ret))))))
((decl . ,decl)
@ -1742,23 +1728,24 @@
)
(decl->info info decl)))
;; ...
((gt . _) (expr->accu o info))
((ge . _) (expr->accu o info))
((ne . _) (expr->accu o info))
((eq . _) (expr->accu o info))
((le . _) (expr->accu o info))
((lt . _) (expr->accu o info))
((lshift . _) (expr->accu o info))
((rshift . _) (expr->accu o info))
((gt . _) (expr->register o info))
((ge . _) (expr->register o info))
((ne . _) (expr->register o info))
((eq . _) (expr->register o info))
((le . _) (expr->register o info))
((lt . _) (expr->register o info))
((lshift . _) (expr->register o info))
((rshift . _) (expr->register o info))
;; EXPR
((expr-stmt ,expression)
(let ((info (expr->accu expression info)))
(append-text info (wrap-as (i386:accu-zero?)))))
(let* ((info (expr->register expression info))
(info (append-text info (wrap-as (i386:accu-zero?)))))
(free-register info)))
;; FIXME: why do we get (post-inc ...) here
;; (array-ref
(_ (let ((info (expr->accu o info)))
(_ (let ((info (expr->register o info)))
(append-text info (wrap-as (i386:accu-zero?))))))))
(define (ast-list->info o info)
@ -1912,13 +1899,13 @@
(define (init->accu o info)
(pmatch o
((initzer-list (initzer ,expr)) (expr->accu expr info))
((initzer-list (initzer ,expr)) (expr->register expr info))
(((#:string ,string))
(append-text info (list (i386:label->accu `(#:string ,string)))))
((,number . _) (guard (number? number))
(append-text info (wrap-as (i386:value->accu 0))))
((,c . ,_) (guard (char? c)) info)
(_ (expr->accu o info))))
(_ (expr->register o info))))
(define (init-struct-field local field init info)
(let* ((offset (field-offset info (local:type local) (car field)))
@ -1930,7 +1917,7 @@
(local->accu local)
(wrap-as (append (i386:accu->base)))
(wrap-as (append (i386:push-base)))
(.text (expr->accu init empty))
(.text (expr->register init empty))
(wrap-as (append (i386:pop-base)))
(wrap-as (case size
((1) (i386:byte-accu->base-mem+n offset))
@ -1951,7 +1938,7 @@
(local->accu local)
(wrap-as (append (i386:accu->base)))
(wrap-as (append (i386:push-base)))
(.text (expr->accu init empty))
(.text (expr->register init empty))
(wrap-as (append (i386:pop-base)))
(wrap-as (case size
((1) (i386:byte-accu->base-mem+n offset))

View File

@ -0,0 +1,67 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Mes.
;;;
;;; GNU 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.
;;;
;;; GNU 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Initialize MesCC as i386/x86 compiler
;;; Code:
(define-module (mescc i386 info)
#:use-module (mescc info)
#:export (x86-info))
(define (x86-info)
(make <info> #:types i386:type-alist #:registers i386:registers))
;; FIXME: use abstract, unlimited R0...RN and make concrete in second pass?
(define i386:registers '("eax" "ebx" "ecx" "edx" "esi"))
(define i386:type-alist
`(("char" . ,(make-type 'signed 1 #f))
("short" . ,(make-type 'signed 2 #f))
("int" . ,(make-type 'signed 4 #f))
("long" . ,(make-type 'signed 4 #f))
("default" . ,(make-type 'signed 4 #f))
;;("long long" . ,(make-type 'signed 8 #f))
;;("long long int" . ,(make-type 'signed 8 #f))
("long long" . ,(make-type 'signed 4 #f)) ;; FIXME
("long long int" . ,(make-type 'signed 4 #f))
("void" . ,(make-type 'void 1 #f))
;; FIXME sign
("unsigned char" . ,(make-type 'unsigned 1 #f))
("unsigned short" . ,(make-type 'unsigned 2 #f))
("unsigned" . ,(make-type 'unsigned 4 #f))
("unsigned int" . ,(make-type 'unsigned 4 #f))
("unsigned long" . ,(make-type 'unsigned 4 #f))
;; ("unsigned long long" . ,(make-type 'builtin 8 #f))
;; ("unsigned long long int" . ,(make-type 'builtin 8 #f))
("unsigned long long" . ,(make-type 'unsigned 4 #f)) ;; FIXME
("unsigned long long int" . ,(make-type 'unsigned 4 #f))
("float" . ,(make-type 'float 4 #f))
("double" . ,(make-type 'float 8 #f))
("long double" . ,(make-type 'float 16 #f))
;;
("short int" . ,(make-type 'signed 2 #f))
("unsigned short int" . ,(make-type 'unsigned 2 #f))
("long int" . ,(make-type 'signed 4 #f))
("unsigned long int" . ,(make-type 'unsigned 4 #f))))

View File

@ -44,6 +44,8 @@
.post
.break
.continue
.allocated
.registers
<type>
make-type
@ -115,7 +117,7 @@
structured-type?))
(define-immutable-record-type <info>
(make-<info> types constants functions globals locals statics function text post break continue)
(make-<info> types constants functions globals locals statics function text post break continue allocated registers)
info?
(types .types)
(constants .constants)
@ -127,11 +129,13 @@
(text .text)
(post .post)
(break .break)
(continue .continue))
(continue .continue)
(registers .registers)
(allocated .allocated))
(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()))
(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (post '()) (break '()) (continue '()) (allocated '()) (registers '()))
(cond ((eq? o <info>)
(make-<info> types constants functions globals locals statics function text post break continue))))
(make-<info> types constants functions globals locals statics function text post break continue allocated registers))))
(define (clone o . rest)
(cond ((info? o)
@ -145,7 +149,9 @@
(text (.text o))
(post (.post o))
(break (.break o))
(continue (.continue o)))
(continue (.continue o))
(allocated (.allocated o))
(registers (.registers o)))
(let-keywords rest
#f
((types types)
@ -158,8 +164,10 @@
(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 #:post post #:break break #:continue continue))))))
(continue continue)
(allocated allocated)
(registers registers))
(make <info> #:types types #:constants constants #:functions functions #:globals globals #:locals locals #:statics statics #:function function #:text text #:post post #:break break #:continue continue #:allocated allocated #:registers registers))))))
;; ("int" . ,(make-type 'builtin 4 #f 0 #f))
;; (make-type 'enum 4 0 fields)

View File

@ -24,6 +24,7 @@
#:use-module (mes guile)
#:use-module (mes misc)
#:use-module (mescc i386 info)
#:use-module (mescc preprocess)
#:use-module (mescc compile)
#:use-module (mescc M1)
@ -32,6 +33,8 @@
mescc:assemble
mescc:link))
(define %info (x86-info))
(define GUILE-with-output-to-file with-output-to-file)
(define (with-output-to-file file-name thunk)
(if (equal? file-name "-") (thunk)
@ -82,11 +85,11 @@
(includes (cons dir includes))
(prefix (option-ref options 'prefix "")))
(with-input-from-file file-name
(cut c99-input->info #:prefix prefix #:defines defines #:includes includes))))
(cut c99-input->info %info #:prefix prefix #:defines defines #:includes includes))))
(define (E->info options file-name)
(let ((ast (with-input-from-file file-name read)))
(c99-ast->info ast)))
(c99-ast->info %info ast)))
(define (mescc:assemble options)
(let* ((files (option-ref options '() '("a.c")))

View File

@ -18,18 +18,11 @@
* along with GNU Mes. If not, see <http://www.gnu.org/licenses/>.
*/
int
test ()
{
return 2;
}
//V=2 CC64=gcc build-aux/cc64-mes.sh scaffold/main
int
main (int argc, char *argv[])
{
if (argc == 6) return 42;
int a = 39;
if (argc > 1) a+=argc;
else a++;
return a + test ();
argc = 42;
return argc;
}