mescc: Remove duplication of string globals.

* module/language/c99/compiler.mes (expr->global): Curry-in globals.
  Update callers.
  (initzer->global): Likewise.
This commit is contained in:
Jan Nieuwenhuizen 2017-06-12 10:49:31 +02:00
parent d46994f2fe
commit 7cce8c6090
2 changed files with 32 additions and 25 deletions

View file

@ -258,7 +258,7 @@
(make-global `(#:string ,string) "string" 0 (append (string->list string) (list #\nul)))) (make-global `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
(define (int->global value) (define (int->global value)
(make-global `(#:string ,(number->string value)) "int" 0 (int->bv32 value))) (make-global (number->string value) "int" 0 (int->bv32 value)))
(define (ident->global name type pointer value) (define (ident->global name type pointer value)
(make-global name type pointer (if (pair? value) value (int->bv32 value)))) (make-global name type pointer (if (pair? value) value (int->bv32 value))))
@ -503,7 +503,7 @@
(pmatch o (pmatch o
((expr) info) ((expr) info)
((p-expr (string ,string)) ((p-expr (string ,string))
(let* ((globals (append globals (list (string->global 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))))))
@ -973,16 +973,21 @@
(,name name) (,name name)
(_ (error "decl->type: unsupported: " o)))) (_ (error "decl->type: unsupported: " o))))
(define (expr->global o) (define (expr->global globals)
(pmatch o (lambda (o)
((p-expr (string ,string)) (string->global string)) (pmatch o
((p-expr (fixed ,value)) (int->global (cstring->number value))) ((p-expr (string ,string))
(_ #f))) (let ((g `(#:string ,string)))
(or (assoc g globals)
(string->global string))))
((p-expr (fixed ,value)) (int->global (cstring->number value)))
(_ #f))))
(define (initzer->global o) (define (initzer->global globals)
(pmatch o (lambda (o)
((initzer ,initzer) (expr->global initzer)) (pmatch o
(_ #f))) ((initzer ,initzer) ((expr->global globals) initzer))
(_ #f))))
(define (byte->hex o) (define (byte->hex o)
(string->number (string-drop o 2) 16)) (string->number (string-drop o 2) 16))
@ -1594,13 +1599,12 @@
((decl (decl-spec-list (type-spec (fixed-type ,type)) . _) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,string)))))) ((decl (decl-spec-list (type-spec (fixed-type ,type)) . _) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,string))))))
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 1)) (let* ((locals (add-local locals name type 1))
(globals (append globals (list (string->global string)))) (globals ((globals:add-string globals) string))
(info (clone info #:locals locals #:globals globals))) (info (clone info #:locals locals #:globals globals)))
(append-text info (append (append-text info (append
(list (i386:label->accu `(#:string ,string))) (list (i386:label->accu `(#:string ,string)))
((accu->ident info) name)))) ((accu->ident info) name))))
(let* ((global (string->global string)) (let* ((globals ((globals:add-string globals) string))
(globals (append globals (list global)))
(size 4) (size 4)
(global (make-global name type 1 (initzer->data `(initzer (p-expr (string ,string)))))) (global (make-global name type 1 (initzer->data `(initzer (p-expr (string ,string))))))
(globals (append globals (list global)))) (globals (append globals (list global))))
@ -1910,7 +1914,7 @@
;; char *bla[] = {"a", "b"}; ;; char *bla[] = {"a", "b"};
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (array-of (ident ,name))) (initzer (initzer-list . ,initzers)))))
(let* ((type (decl->type type)) (let* ((type (decl->type type))
(entries (map initzer->global initzers)) (entries (map (initzer->global globals) initzers))
(entry-size 4) (entry-size 4)
(size (* (length entries) entry-size)) (size (* (length entries) entry-size))
(initzers (map (initzer->non-const info) initzers))) (initzers (map (initzer->non-const info) initzers)))
@ -1918,6 +1922,8 @@
(error "TODO: <type> x[] = {};" o) (error "TODO: <type> x[] = {};" o)
(let* (;;(global (make-global name type 2 (string->list (make-string size #\nul)))) (let* (;;(global (make-global name type 2 (string->list (make-string size #\nul))))
(global (make-global name type 2 (append-map initzer->data initzers))) (global (make-global name type 2 (append-map initzer->data initzers)))
(global-names (map car globals))
(entries (filter (lambda (g) (not (member (car g) global-names))) entries))
(globals (append globals entries (list global)))) (globals (append globals entries (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
@ -1929,7 +1935,10 @@
(size (type->size info type)) (size (type->size info type))
(initzers (map (initzer->non-const info) initzers))) (initzers (map (initzer->non-const info) initzers)))
(if (.function info) (if (.function info)
(let* ((globals (append globals (filter-map initzer->global initzers))) (let* ((initzer-globals (filter-map (initzer->global globals) initzers))
(global-names (map car globals))
(initzer-globals (filter (lambda (g) (not (member (car g) global-names))) initzer-globals))
(globals (append globals initzer-globals))
(locals (let loop ((fields (cdr fields)) (locals locals)) (locals (let loop ((fields (cdr fields)) (locals locals))
(if (null? fields) locals (if (null? fields) locals
(loop (cdr fields) (add-local locals "foobar" "int" 0))))) (loop (cdr fields) (add-local locals "foobar" "int" 0)))))
@ -1948,22 +1957,23 @@
(wrap-as (append (i386:accu->base))) (wrap-as (append (i386:accu->base)))
(.text ((expr->accu empty) initzer)) (.text ((expr->accu empty) initzer))
(wrap-as (i386:accu->base-address+n offset))))))))) (wrap-as (i386:accu->base-address+n offset)))))))))
(let* ((globals (append globals (filter-map initzer->global initzers))) (let* ((initzer-globals (filter-map (initzer->global globals) initzers))
(global-names (map car globals))
(initzer-globals (filter (lambda (g) (not (member (car g) global-names))) initzer-globals))
(globals (append globals initzer-globals))
(global (make-global name type 2 (append-map initzer->data initzers))) (global (make-global name type 2 (append-map initzer->data initzers)))
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))
;;char cc = g_cells[c].cdr; ==> generic? ;;char cc = g_cells[c].cdr; ==> generic?
((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer ,initzer)))) ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer ,initzer))))
(let ((type (decl->type type)) (let ((type (decl->type type))
(initzer ((initzer->non-const info) initzer))) (initzer ((initzer->non-const info) initzer)))
(if (.function info) (if (.function info)
(let* ((locals (add-local locals name type 0)) (let* ((locals (add-local locals name type 0))
(info (clone info #:locals locals))) (info (clone info #:locals locals))
(clone info #:text (info ((expr->accu info) initzer)))
(append (.text ((expr->accu info) initzer)) (append-text info ((accu->ident info) name)))
((accu->ident info) name))))
(let* ((global (make-global name type 2 (initzer->data initzer))) (let* ((global (make-global name type 2 (initzer->data initzer)))
(globals (append globals (list global)))) (globals (append globals (list global))))
(clone info #:globals globals))))) (clone info #:globals globals)))))

View file

@ -947,9 +947,6 @@ test (char *p)
puts ("strcmp (itoa (-1), \"-1\")\n"); puts ("strcmp (itoa (-1), \"-1\")\n");
if (strcmp (itoa (-1), "-1")) return 1; if (strcmp (itoa (-1), "-1")) return 1;
char *fixme_globals;
fixme_globals = "0";
fixme_globals = "1";
puts ("strcmp (itoa (0), \"0\")\n"); puts ("strcmp (itoa (0), \"0\")\n");
if (strcmp (itoa (0), "0")) return 1; if (strcmp (itoa (0), "0")) return 1;