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 (<global>): 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

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

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 <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/>.
+ */
+
+#include <mes/lib.h>
+
+char foo[3] = "foo";
+extern int baz;
+char bar[4] = "bar";
+
+int
+main (void)
+{
+  foo[3] = ':';
+  oputs (foo);
+  return 0;
+}

lib/tests/scaffold/70-extern.stdout

@@ -0,0 +1 @@
+foo:bar

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))
+         (globals (filter (negate (compose global-extern? cdr)) globals))
-         (strings (filter (lambda (g) (and (pair? g) (eq? (car g) #:string))) global-names))
+         (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))))

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)
+(define (make-global-entry name storage type value)
-  (cons name (make-global name type value #f)))
+  (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)
+                             (data (or (and=> string string->list)
-                                        (array-init->data type size init info))))
+                                       (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)

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 <global>
-  (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)                      ; <var>
 
   (value global:value)
+  (storage global:storage)
   (function global:function))
 
-(define (make-global name type value function)
+(define (make-global name type value storage function)
-  (make-global- name type (make-var name type function #f value) value 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)))