mescc: Support function-static variables.

* module/language/c99/info.scm (make): Add statics field.
  (<global>): Add name and function fields.  Update callers.
  (global->string): New function.
* module/mes/M1.mes (object->M1): Update.
* module/language/c99/compiler.mes (clone): Add statics field.
  (ident->accu): For <global>, use global in text (WAS: name).
  (ident-address->accu): Likewise.
  (ident-address->base): Likewise.
  (decl-local->info): New function.
  (decl->info): New function.
  (ast->info): Use them.
  (function->info): Keep globals in object (WAS: global:value only).
* scaffold/tests/46-function-static.c: Test it.

build-aux/check-mescc.sh

@@ -72,6 +72,7 @@ t
 43-for-do-while
 44-switch
 45-void-call
+46-function-static
 50-assert
 51-strcmp
 52-itoa

module/language/c99/compiler.mes

@@ -55,9 +55,6 @@
   (newline (current-error-port))
   (car (last-pair stuff)))
 
-(define (pke . stuff)
-  (car (last-pair stuff)))
-
 (define %prefix (if (string-prefix? "@PREFIX" "@PREFIX@") (or (getenv "PREFIX") "") "@PREFIX@"))
 
 (define mes? (pair? (current-module)))
@@ -149,6 +146,7 @@
                (functions (.functions o))
                (globals (.globals o))
                (locals (.locals o))
+               (statics (.statics o))
                (function (.function o))
                (text (.text o))
                (break (.break o))
@@ -160,11 +158,12 @@
                           (functions functions)
                           (globals globals)
                           (locals locals)
+                          (statics statics)
                           (function function)
                           (text text)
                           (break break)
                           (continue continue))
-                         (make <info> #:types types #:constants constants #:functions functions #:globals globals  #:locals locals #:function function #:text text #:break break #:continue continue))))))
+                         (make <info> #:types types #:constants constants #:functions functions #:globals globals  #:locals locals #:statics statics #:function function #:text text #:break break #:continue continue))))))
 
 (define (ident->constant name value)
   (cons name value))
@@ -578,7 +577,7 @@
           (error "TODO int-de-de-ref")))))
 
 (define (make-global-entry key type pointer value)
-  (cons key (make-global type pointer value)))
+  (cons key (make-global key type pointer value #f)))
 
 (define (string->global-entry string)
   (make-global-entry `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
@@ -679,43 +678,61 @@
 
 (define (ident->accu info)
   (lambda (o)
-    (let ((local (assoc-ref (.locals info) o))
+    (cond ((assoc-ref (.locals info) o)
-          (global (assoc-ref (.globals info) o))
+           =>
-          (constant (assoc-ref (.constants info) o)))
+           (lambda (local)
-      (if local
+             (let* ((ptr (local:pointer local))
-          (let* ((ptr (local:pointer local))
+                    (type (ident->type info o))
-                 (type (ident->type info o))
+                    (size (if (= ptr 0) (ast-type->size info type)
-                 (size (if (= ptr 0) (ast-type->size info type)
+                              4)))
-                           4)))
+               (cond ((< ptr 0) (wrap-as (i386:local-ptr->accu (local:id local))))
-            (cond ((< ptr 0) (wrap-as (i386:local-ptr->accu (local:id local))))
+                     (else (wrap-as (case size
-                  (else (wrap-as (case size
+                                      ((1) (i386:byte-local->accu (local:id local)))
-                                   ((1) (i386:byte-local->accu (local:id local)))
+                                      ((2) (i386:word-local->accu (local:id local)))
-                                   ((2) (i386:word-local->accu (local:id local)))
+                                      (else (i386:local->accu (local:id local))))))))))
-                                   (else (i386:local->accu (local:id local))))))))
+          ((assoc-ref (.statics info) o)
-          (if global
+           =>
-              (let* ((ptr (ident->pointer info o)))
+           (lambda (global)
-                (cond ((< ptr 0) (list (i386:label->accu `(#:address ,o))))
+             (let* ((ptr (ident->pointer info o)))
-                      (else (list (i386:label-mem->accu `(#:address ,o))))))
+               (cond ((< ptr 0) (list (i386:label->accu `(#:address ,global))))
-              (if constant (wrap-as (i386:value->accu constant))
+                     (else (list (i386:label-mem->accu `(#:address ,global))))))))
-                  (list (i386:label->accu `(#:address ,o)))))))))
+          ((assoc-ref (.globals info) o)
+           =>
+           (lambda (global)
+             (let* ((ptr (ident->pointer info o)))
+               (cond ((< ptr 0) (list (i386:label->accu `(#:address ,o))))
+                     (else (list (i386:label-mem->accu `(#:address ,o))))))))
+          ((assoc-ref (.constants info) o)
+           =>
+           (lambda (constant) (wrap-as (i386:value->accu constant))))
+          (else (list (i386:label->accu `(#:address ,o)))))))
 
 (define (ident-address->accu info)
   (lambda (o)
-    (let ((local (assoc-ref (.locals info) o))
+    (cond ((assoc-ref (.locals info) o)
-          (global (assoc-ref (.globals info) o))
+           =>
-          (constant (assoc-ref (.constants info) o)))
+           (lambda (local) (wrap-as (i386:local-ptr->accu (local:id local)))))
-      (if local (wrap-as (i386:local-ptr->accu (local:id local)))
+          ((assoc-ref (.statics info) o)
-          (if global (list (i386:label->accu `(#:address ,o)))
+           =>
-              (list (i386:label->accu `(#:address ,o))))))))
+           (lambda (global) (list (i386:label->accu `(#:address ,global)))))
+          ((assoc-ref (.globals info) o)
+           =>
+           (lambda (global) (list (i386:label->accu `(#:address ,global)))))
+          (else (list (i386:label->accu `(#:address ,o)))))))
 
 (define (ident-address->base info)
   (lambda (o)
-    (let ((local (assoc-ref (.locals info) o))
+    (cond
-          (global (assoc-ref (.globals info) o))
+     ((assoc-ref (.locals info) o)
-          (constant (assoc-ref (.constants info) o)))
+      =>
-      (if local (wrap-as (i386:local-ptr->base (local:id local)))
+      (lambda (local) (wrap-as (i386:local-ptr->base (local:id local)))))
-          (if global (list (i386:label->base `(#:address ,o)))
+     ((assoc-ref (.statics info) o)
-              (list (i386:label->base `(#:address ,o))))))))
+      =>
+      (lambda (global) (list (i386:label->base `(#:address ,global)))))
+     ((assoc-ref (.globals info) o)
+      =>
+      (lambda (global) (list (i386:label->base `(#:address ,global)))))
+     (else (list (i386:label->base `(#:address ,o)))))))
 
 (define (value->accu v)
   (wrap-as (i386:value->accu v)))
@@ -1634,6 +1651,25 @@
                        (_ (loop2 (cdr statements) (append c (list s)))))))))
             (_ (error "statements->clauses: unsupported:" s)))))))
 
+(define (global->static function)
+  (lambda (o)
+    (cons (car o) (set-field (cdr o) (global:function) function))))
+
+(define (decl-local->info info)
+  (lambda (o)
+    (pmatch o
+      (((decl-spec-list (stor-spec (static)) (type-spec ,type)) (init-declr-list ,init))
+       (let* ((function (.function info))
+              (i (clone info #:function #f #:globals '()))
+              (i ((decl->info i) `(decl (decl-spec-list (type-spec ,type)) (init-declr-list ,init))))
+              (statics (map (global->static function) (.globals i))))
+         (clone info #:statics (append statics (.statics info)))))
+      (_ #f))))
+
+(define (decl-global->info info)
+  (lambda (o)
+    #f))
+
 (define (decl->info info)
   (lambda (o)
     (let ((functions (.functions info))
@@ -1687,6 +1723,11 @@
         ((decl (decl-spec-list (stor-spec (extern)) ,type) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))))
          (declare name))
 
+        ;; static
+        ((decl (decl-spec-list (stor-spec (static)) (type-spec ,type)) (init-declr-list ,init-declr-list))
+         (guard (not (.function info)))
+         ((decl->info info) `(decl (decl-spec-list (type-spec ,type)) (init-declr-list ,init-declr-list))))
+
         ;; struct TCCState;
         ((decl (decl-spec-list (type-spec (struct-ref (ident ,name)))))
          info)
@@ -2262,7 +2303,10 @@
            (append-text info (append (wrap-as (i386:ret))))))
 
         ((decl . ,decl)
-         ((decl->info info) o))
+         (or (if (.function info)
+                 ((decl-local->info info) decl)
+                 ((decl-global->info info) decl))
+             ((decl->info info) o)))
 
         ;; ...
         ((gt . _) ((expr->accu info) o))
@@ -2438,8 +2482,10 @@
                                       (stack (and count (* count 4))))
                                  (if (and stack (getenv "MESC_DEBUG")) (stderr "        stack: ~a\n" stack))
                                  (clone info
-                                       #:function #f
+                                        #:function #f
-                                       #:functions (append (.functions info) (list (cons name (assert-return (.text info)))))))
+                                        #:globals (append (.statics info) (.globals info))
+                                        #:statics '()
+                                        #:functions (append (.functions info) (list (cons name (assert-return (.text info)))))))
             (let* ((statement (car statements)))
               (loop (cdr statements)
                     ((ast->info info) (car statements)))))))))
@@ -2471,7 +2517,7 @@
 (define* (info->object o)
   (stderr "compiling: object\n")
   `((functions . ,(.functions o))
-    (globals . ,(map (lambda (g) (cons (car g) (global:value (cdr g)))) (.globals o)))))
+    (globals . ,(.globals o))))
 
 (define* (c99-input->elf #:key (defines '()) (includes '()))
   ((compose object->elf info->object (c99-input->info #:defines defines #:includes includes))))

module/language/c99/compiler.scm

@@ -24,6 +24,7 @@
 
 (define-module (language c99 compiler)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-26)
   #:use-module (system base pmatch)
   #:use-module (ice-9 optargs)

module/language/c99/info.mes

@@ -23,8 +23,6 @@
 ;;; Code:
 
 (mes-use-module (srfi srfi-9))
-(define-macro (define-immutable-record-type type constructor+params predicate . fields)
+(mes-use-module (srfi srfi-9 gnu))
-  `(define-record-type ,type ,constructor+params ,predicate ,@fields))
-
 (include-from-path "language/c99/info.scm")
 

module/language/c99/info.scm

@@ -26,6 +26,7 @@
   #:use-module (ice-9 optargs)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-26)
   #:export (<info>
             make
             make-<info>
@@ -37,6 +38,7 @@
             .globals
             .locals
             .function
+            .statics
             .text
             .break
             .continue
@@ -50,9 +52,12 @@
 
             make-global
             global?
+            global:name
             global:type
             global:pointer
             global:value
+            global:function
+            global->string
 
             make-local
             local?
@@ -69,20 +74,21 @@
   (mes-use-module (mes optargs))))
 
 (define-immutable-record-type <info>
-  (make-<info> types constants functions globals locals function text break continue)
+  (make-<info> types constants functions globals locals statics function text break continue)
   info?
   (types .types)
   (constants .constants)
   (functions .functions)
   (globals .globals)
   (locals .locals)
+  (statics .statics)
   (function .function)
   (text .text)
   (break .break)
   (continue .continue))
 
-(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (function #f) (text '()) (break '()) (continue '()))
+(define* (make o #:key (types '()) (constants '()) (functions '()) (globals '()) (locals '()) (statics '()) (function #f) (text '()) (break '()) (continue '()))
-  (make-<info> types constants functions globals locals function text break continue))
+  (make-<info> types constants functions globals locals statics function text break continue))
 
 (define-immutable-record-type <type>
   (make-type type size pointer description)
@@ -93,11 +99,17 @@
   (description type:description))
 
 (define-immutable-record-type <global>
-  (make-global type pointer value)
+  (make-global name type pointer value function)
   global?
+  (name global:name)
   (type global:type)
   (pointer global:pointer)
-  (value global:value))
+  (value global:value)
+  (function global:function))
+
+(define (global->string o)
+  (or (and=> (global:function o) (cut string-append <> "-" (global:name o)))
+      (global:name o)))
 
 (define-immutable-record-type <local>
   (make-local type pointer id)

module/mes/M1.mes

@@ -43,6 +43,13 @@
 (define (stderr string . rest)
   (apply logf (cons* (current-error-port) string rest)))
 
+(define (pke . stuff)
+  (newline (current-error-port))
+  (display ";;; " (current-error-port))
+  (write stuff (current-error-port))
+  (newline (current-error-port))
+  (car (last-pair stuff)))
+
 (define (objects->M1 file-name objects)
   ((compose (cut object->M1 file-name <>) merge-objects) objects))
 
@@ -116,16 +123,19 @@
                           (string-append "!" (number->string o)))))
        ((and (pair? o) (keyword? (car o)))
         (pmatch o
-         ;; FIXME
+          ;; FIXME
-         ((#:address (#:string ,string)) (hex2:address (string->label `(#:string ,string))))
+          ((#:address (#:string ,string)) (hex2:address (string->label `(#:string ,string))))
-         ((#:string (#:address ,address)) (hex2:address address))
+          ((#:address (#:address ,address)) (guard (string? address))
-         ((#:address (#:address ,address)) (hex2:address address))
+           (hex2:address address))
-         ((#:string ,string) (hex2:address (string->label o)))
+          ((#:address (#:address ,global)) (guard (global? global))
-         ((#:address ,address) (hex2:address address))
+           (hex2:address (global->string global)))
-         ((#:offset ,offset) (hex2:offset offset))
+          ((#:string ,string) (hex2:address (string->label o)))
-         ((#:offset1 ,offset1) (hex2:offset1 offset1))
+          ((#:address ,address) (string? address) (hex2:address address))
-         ((#:immediate ,immediate) (hex2:immediate immediate))
+          ((#:address ,global) (global? global) (error "urg1: global without a name\n"))
-         ((#:immediate1 ,immediate1) (hex2:immediate1 immediate1))))
+          ((#:offset ,offset) (hex2:offset offset))
+          ((#:offset1 ,offset1) (hex2:offset1 offset1))
+          ((#:immediate ,immediate) (hex2:immediate immediate))
+          ((#:immediate1 ,immediate1) (hex2:immediate1 immediate1))))
        ((pair? o) (string-join (map text->M1 o)))))
     (define (write-function o)
       (let ((name (car o))
@@ -150,17 +160,19 @@
             (let* ((label o)
                    (function? (member label function-names))
                    (string-label (string->label label))
-                   (string? (not (equal? string-label "_string_#f")))
+                   (string? (not (equal? string-label "_string_#f"))))
-                   (global? (member label global-names)))
+              (cond ((and (pair? o) (global? (cdr o))) (string-append "&" (global->string o)))
-              (if (or global? string?) (string-append "&" label)
+                    ((and (not string?) (not function?)) (stderr "warning: unresolved label: ~s\n" label))
-                  (begin (if (not function?) (stderr "warning: unresolved label: ~s\n" label))
+                    (else (string-append "&" label))))))
-                         (string-append "&" label))))))
+      (let* ((label (cond
-      (let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
+                     ((and (pair? (car o)) (eq? (caar o) #:string))
-                        (string->label (car o))))
+                      (string->label (car o)))
+                     ((global? (cdr o)) (global->string (cdr o)))
+                     (else (car o))))
              (string? (string-prefix? "_string" label))
              (foo (if (not (eq? (car (string->list label)) #\_))
                       (display (string-append "    :" label "\n") (current-error-port))))
-             (data (cdr o))
+             (data ((compose global:value cdr) o))
              (data (filter-map labelize data))
              (len (length data))
              (string-max (or (and=> (getenv "M1_STRING_MAX") string->number) 256))

scaffold/tests/46-function-static.c

@@ -0,0 +1,34 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * 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.
+ *
+ * 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 Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+int
+test ()
+{
+  static int i = 1;
+  return i--;
+}
+
+static int i = 2;
+int
+main ()
+{
+  test ();
+  return test ();
+}