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

mescc: Do not dump variables with extern storage.

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2019-07-27 17:22:00 +02:00
parent e8626841f3
commit 26891251a6
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
6 changed files with 70 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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

33
lib/tests/scaffold/70-extern.c Normal file
View file

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

1
lib/tests/scaffold/70-extern.stdout Normal file
View file

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

14
module/mescc/M1.scm
View file

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

34
module/mescc/compile.scm
View file

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

8
module/mescc/info.scm
View file

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