From 26891251a6cf38cb51016585ec24b034c6f4cfa9 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 27 Jul 2019 17:22:00 +0200 Subject: [PATCH] mescc: Do not dump variables with extern storage. * lib/tests/scaffold/70-extern.stdout: New file. * lib/tests/scaffold/70-extern.c: New file. * build-aux/check-mescc.sh (TESTS): Add it.. * module/mescc/M1.scm (global-string?, global-extern?): New function. (info->M1): Dump strings first. Skip extern symbols. * module/mescc/info.scm (): Add storage field. (make-global): Add storage parameter. Pass it. * module/mescc/compile.scm (make-global-entry): Likewise. (global->info): Likewise. (init-declr->info): Likewise. (decl->info): Pass storage. --- build-aux/check-mescc.sh | 1 + lib/tests/scaffold/70-extern.c | 33 +++++++++++++++++++++++++ lib/tests/scaffold/70-extern.stdout | 1 + module/mescc/M1.scm | 14 ++++++++--- module/mescc/compile.scm | 38 ++++++++++++++--------------- module/mescc/info.scm | 8 +++--- 6 files changed, 70 insertions(+), 25 deletions(-) create mode 100644 lib/tests/scaffold/70-extern.c create mode 100644 lib/tests/scaffold/70-extern.stdout diff --git a/build-aux/check-mescc.sh b/build-aux/check-mescc.sh index 0a3cb882..53972e29 100755 --- a/build-aux/check-mescc.sh +++ b/build-aux/check-mescc.sh @@ -183,6 +183,7 @@ lib/tests/scaffold/7u-vstack.c lib/tests/scaffold/70-array-in-struct-init.c lib/tests/scaffold/70-struct-short-enum-init.c lib/tests/scaffold/70-struct-post.c +lib/tests/scaffold/70-extern.c lib/tests/setjmp/80-setjmp.c lib/tests/stdio/80-sscanf.c lib/tests/stdlib/80-qsort.c diff --git a/lib/tests/scaffold/70-extern.c b/lib/tests/scaffold/70-extern.c new file mode 100644 index 00000000..c20268a2 --- /dev/null +++ b/lib/tests/scaffold/70-extern.c @@ -0,0 +1,33 @@ +/* -*-comment-start: "//";comment-end:""-*- + * GNU Mes --- Maxwell Equations of Software + * Copyright © 2019 Jan (janneke) Nieuwenhuizen + * + * 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 . + */ + +#include + +char foo[3] = "foo"; +extern int baz; +char bar[4] = "bar"; + +int +main (void) +{ + foo[3] = ':'; + oputs (foo); + return 0; +} diff --git a/lib/tests/scaffold/70-extern.stdout b/lib/tests/scaffold/70-extern.stdout new file mode 100644 index 00000000..ed3b07fa --- /dev/null +++ b/lib/tests/scaffold/70-extern.stdout @@ -0,0 +1 @@ +foo:bar \ No newline at end of file diff --git a/module/mescc/M1.scm b/module/mescc/M1.scm index 4d59ee8d..66740230 100644 --- a/module/mescc/M1.scm +++ b/module/mescc/M1.scm @@ -100,12 +100,19 @@ (display sep)) (loop (cdr o))))) +(define (global-string? o) + (and (pair? o) (pair? (car o)) (eq? (caar o) #:string))) + +(define (global-extern? o) + (and=> (global:storage o) (cut eq? <> 'extern))) + (define* (info->M1 file-name o #:key align? verbose?) (let* ((functions (.functions o)) (function-names (map car functions)) (globals (.globals o)) - (global-names (map car globals)) - (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names)) + (globals (filter (negate (compose global-extern? cdr)) globals)) + (strings (filter global-string? globals)) + (strings (map car strings)) (reg-size (type:size (assoc-ref (.types o) "*")))) (define (string->label o) (let ((index (list-index (lambda (s) (equal? s o)) strings))) @@ -245,4 +252,5 @@ (display "\n\n:HEX2_data\n")) (when verbose? (display "M1: globals\n" (current-error-port))) - (for-each write-global globals))) + (for-each write-global (filter global-string? globals)) + (for-each write-global (filter (negate global-string?) globals)))) diff --git a/module/mescc/compile.scm b/module/mescc/compile.scm index 22c5968e..74a2deff 100644 --- a/module/mescc/compile.scm +++ b/module/mescc/compile.scm @@ -419,12 +419,12 @@ (define (append-text info text) (clone info #:text (append (.text info) text))) -(define (make-global-entry name type value) - (cons name (make-global name type value #f))) +(define (make-global-entry name storage type value) + (cons name (make-global name type value storage #f))) (define (string->global-entry string) (let ((value (append (string->list string) (list #\nul)))) - (make-global-entry `(#:string ,string) "char" value))) + (make-global-entry `(#:string ,string) '() "char" value))) (define (make-local-entry name type id) (cons name (make-local name type id))) @@ -2003,7 +2003,7 @@ (((decl-spec-list (type-spec ,type)) (init-declr-list . ,inits)) (let* ((info (type->info type #f info)) (type (ast->type type info))) - (fold (cut init-declr->info type <> <>) info (map cdr inits)))) + (fold (cut init-declr->info type 'storage <> <>) info (map cdr inits)))) (((decl-spec-list (type-spec ,type))) (type->info type #f info)) (((decl-spec-list (stor-spec (typedef)) (type-spec ,type)) (init-declr-list (init-declr (ident ,name)))) @@ -2027,9 +2027,9 @@ (let* ((info (type->info type #f info)) (type (ast->type type info)) (function (.function info))) - (if (not function) (fold (cut init-declr->info type <> <>) info (map cdr inits)) + (if (not function) (fold (cut init-declr->info type store <> <>) info (map cdr inits)) (let* ((tmp (clone info #:function #f #:globals '())) - (tmp (fold (cut init-declr->info type <> <>) tmp (map cdr inits))) + (tmp (fold (cut init-declr->info type store <> <>) tmp (map cdr inits))) (statics (map (global->static function) (.globals tmp))) (strings (filter string-global? (.globals tmp)))) (clone info #:globals (append (.globals info) strings) @@ -2207,7 +2207,7 @@ (local (cdr local))) (init-local local init 0 info))) -(define (global->info type name o init info) +(define (global->info storage type name o init info) (let* ((rank (->rank type)) (size (->size type info)) (data (cond ((not init) (string->list (make-string size #\nul))) @@ -2215,8 +2215,8 @@ (let* ((string (array-init->string init)) (size (or (and string (max size (1+ (string-length string)))) size)) - (data (or (and=> string string->list) - (array-init->data type size init info)))) + (data (or (and=> string string->list) + (array-init->data type size init info)))) (append data (string->list (make-string (max 0 (- size (length data))) #\nul))))) ((structured-type? type) (let ((data (init->data type init info))) @@ -2224,7 +2224,7 @@ (else (let ((data (init->data type init info))) (append data (string->list (make-string (max 0 (- size (length data))) #\nul))))))) - (global (make-global-entry name type data))) + (global (make-global-entry name storage type data))) (clone info #:globals (append (.globals info) (list global))))) (define (array-init-element->data type o info) @@ -2321,17 +2321,17 @@ (cdr o)))) (_ #f))) -(define (init-declr->info type o info) +(define (init-declr->info type storage o info) (pmatch o (((ident ,name)) (if (.function info) (local->info type name o #f info) - (global->info type name o #f info))) + (global->info storage type name o #f info))) (((ident ,name) (initzer ,init)) (let* ((strings (init->strings init info)) (info (if (null? strings) info (clone info #:globals (append (.globals info) strings))))) (if (.function info) (local->info type name o init info) - (global->info type name o init info)))) + (global->info storage type name o init info)))) (((ftn-declr (ident ,name) . ,_)) (let ((functions (.functions info))) (if (member name functions) info @@ -2341,16 +2341,16 @@ (let* ((rank (pointer->rank pointer)) (type (rank+= type rank))) (if (.function info) (local->info type name o init info) - (global->info type name o init info)))) + (global->info storage type name o init info)))) (((ftn-declr (scope (ptr-declr ,pointer (ident ,name))) ,param-list)) (let* ((rank (pointer->rank pointer)) (type (rank+= type rank))) (if (.function info) (local->info type name o '() info) - (global->info type name o '() info)))) + (global->info storage type name o '() info)))) (((ptr-declr ,pointer . ,_) . ,init) (let* ((rank (pointer->rank pointer)) (type (rank+= type rank))) - (init-declr->info type (append _ init) info))) + (init-declr->info type storage (append _ init) info))) (((array-of (ident ,name) ,count) . ,init) (let* ((strings (init->strings init info)) (info (if (null? strings) info @@ -2358,7 +2358,7 @@ (count (expr->number info count)) (type (make-c-array type count))) (if (.function info) (local->info type name o init info) - (global->info type name o init info)))) + (global->info storage type name o init info)))) (((array-of (ident ,name)) . ,init) (let* ((strings (init->strings init info)) (info (if (null? strings) info @@ -2366,7 +2366,7 @@ (count (length (cadar init))) (type (make-c-array type count))) (if (.function info) (local->info type name o init info) - (global->info type name o init info)))) + (global->info storage type name o init info)))) ;; FIXME: recursion (((array-of (array-of (ident ,name) ,count1) ,count) . ,init) (let* ((strings (init->strings init info)) @@ -2376,7 +2376,7 @@ (count1 (expr->number info count1)) (type (make-c-array (make-c-array type count1) count))) (if (.function info) (local->info type name o init info) - (global->info type name o init info)))) + (global->info storage type name o init info)))) (_ (error "init-declr->info: not supported: " o)))) (define (enum-def-list->constants constants fields) diff --git a/module/mescc/info.scm b/module/mescc/info.scm index 49ce33ab..49a0974f 100644 --- a/module/mescc/info.scm +++ b/module/mescc/info.scm @@ -91,6 +91,7 @@ global:c-array global:var global:value + global:storage global:function global->string @@ -217,17 +218,18 @@ (value var:value)) (define-immutable-record-type - (make-global- name type var value function) + (make-global- name type var value storage function) global? (name global:name) (type global:type) (var global:var) ; (value global:value) + (storage global:storage) (function global:function)) -(define (make-global name type value function) - (make-global- name type (make-var name type function #f value) value function)) +(define (make-global name type value storage function) + (make-global- name type (make-var name type function #f value) value storage function)) (define (global->string o) (or (and=> (global:function o) (cut string-append <> "-" (global:name o)))