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.
This commit is contained in:
Jan Nieuwenhuizen
parent
1cd97f1172
commit
be60b3e49b
|
|
@ -72,6 +72,7 @@ t
|
|||
43-for-do-while
|
||||
44-switch
|
||||
45-void-call
|
||||
46-function-static
|
||||
50-assert
|
||||
51-strcmp
|
||||
52-itoa
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
(global (assoc-ref (.globals info) o))
|
||||
(constant (assoc-ref (.constants info) o)))
|
||||
(if local
|
||||
(let* ((ptr (local:pointer local))
|
||||
(type (ident->type info o))
|
||||
(size (if (= ptr 0) (ast-type->size info type)
|
||||
4)))
|
||||
(cond ((< ptr 0) (wrap-as (i386:local-ptr->accu (local:id local))))
|
||||
(else (wrap-as (case size
|
||||
((1) (i386:byte-local->accu (local:id local)))
|
||||
((2) (i386:word-local->accu (local:id local)))
|
||||
(else (i386:local->accu (local:id local))))))))
|
||||
(if global
|
||||
(let* ((ptr (ident->pointer info o)))
|
||||
(cond ((< ptr 0) (list (i386:label->accu `(#:address ,o))))
|
||||
(else (list (i386:label-mem->accu `(#:address ,o))))))
|
||||
(if constant (wrap-as (i386:value->accu constant))
|
||||
(list (i386:label->accu `(#:address ,o)))))))))
|
||||
(cond ((assoc-ref (.locals info) o)
|
||||
=>
|
||||
(lambda (local)
|
||||
(let* ((ptr (local:pointer local))
|
||||
(type (ident->type info o))
|
||||
(size (if (= ptr 0) (ast-type->size info type)
|
||||
4)))
|
||||
(cond ((< ptr 0) (wrap-as (i386:local-ptr->accu (local:id local))))
|
||||
(else (wrap-as (case size
|
||||
((1) (i386:byte-local->accu (local:id local)))
|
||||
((2) (i386:word-local->accu (local:id local)))
|
||||
(else (i386:local->accu (local:id local))))))))))
|
||||
((assoc-ref (.statics info) o)
|
||||
=>
|
||||
(lambda (global)
|
||||
(let* ((ptr (ident->pointer info o)))
|
||||
(cond ((< ptr 0) (list (i386:label->accu `(#:address ,global))))
|
||||
(else (list (i386:label-mem->accu `(#:address ,global))))))))
|
||||
((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))
|
||||
(global (assoc-ref (.globals info) o))
|
||||
(constant (assoc-ref (.constants info) o)))
|
||||
(if local (wrap-as (i386:local-ptr->accu (local:id local)))
|
||||
(if global (list (i386:label->accu `(#:address ,o)))
|
||||
(list (i386:label->accu `(#:address ,o))))))))
|
||||
(cond ((assoc-ref (.locals info) o)
|
||||
=>
|
||||
(lambda (local) (wrap-as (i386:local-ptr->accu (local:id local)))))
|
||||
((assoc-ref (.statics info) 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))
|
||||
(global (assoc-ref (.globals info) o))
|
||||
(constant (assoc-ref (.constants info) o)))
|
||||
(if local (wrap-as (i386:local-ptr->base (local:id local)))
|
||||
(if global (list (i386:label->base `(#:address ,o)))
|
||||
(list (i386:label->base `(#:address ,o))))))))
|
||||
(cond
|
||||
((assoc-ref (.locals info) o)
|
||||
=>
|
||||
(lambda (local) (wrap-as (i386:local-ptr->base (local:id local)))))
|
||||
((assoc-ref (.statics info) 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
|
||||
#:functions (append (.functions info) (list (cons name (assert-return (.text info)))))))
|
||||
#:function #f
|
||||
#: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))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -23,8 +23,6 @@
|
|||
;;; Code:
|
||||
|
||||
(mes-use-module (srfi srfi-9))
|
||||
(define-macro (define-immutable-record-type type constructor+params predicate . fields)
|
||||
`(define-record-type ,type ,constructor+params ,predicate ,@fields))
|
||||
|
||||
(mes-use-module (srfi srfi-9 gnu))
|
||||
(include-from-path "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 '()))
|
||||
(make-<info> types constants functions globals locals function 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 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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
((#:address (#:string ,string)) (hex2:address (string->label `(#:string ,string))))
|
||||
((#:string (#:address ,address)) (hex2:address address))
|
||||
((#:address (#:address ,address)) (hex2:address address))
|
||||
((#:string ,string) (hex2:address (string->label o)))
|
||||
((#:address ,address) (hex2:address address))
|
||||
((#:offset ,offset) (hex2:offset offset))
|
||||
((#:offset1 ,offset1) (hex2:offset1 offset1))
|
||||
((#:immediate ,immediate) (hex2:immediate immediate))
|
||||
((#:immediate1 ,immediate1) (hex2:immediate1 immediate1))))
|
||||
;; FIXME
|
||||
((#:address (#:string ,string)) (hex2:address (string->label `(#:string ,string))))
|
||||
((#:address (#:address ,address)) (guard (string? address))
|
||||
(hex2:address address))
|
||||
((#:address (#:address ,global)) (guard (global? global))
|
||||
(hex2:address (global->string global)))
|
||||
((#:string ,string) (hex2:address (string->label o)))
|
||||
((#:address ,address) (string? address) (hex2:address address))
|
||||
((#:address ,global) (global? global) (error "urg1: global without a name\n"))
|
||||
((#: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")))
|
||||
(global? (member label global-names)))
|
||||
(if (or global? string?) (string-append "&" label)
|
||||
(begin (if (not function?) (stderr "warning: unresolved label: ~s\n" label))
|
||||
(string-append "&" label))))))
|
||||
(let* ((label (if (not (and (pair? (car o)) (eq? (caar o) #:string))) (car o)
|
||||
(string->label (car o))))
|
||||
(string? (not (equal? string-label "_string_#f"))))
|
||||
(cond ((and (pair? o) (global? (cdr o))) (string-append "&" (global->string o)))
|
||||
((and (not string?) (not function?)) (stderr "warning: unresolved label: ~s\n" label))
|
||||
(else (string-append "&" label))))))
|
||||
(let* ((label (cond
|
||||
((and (pair? (car o)) (eq? (caar o) #:string))
|
||||
(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))
|
||||
|
|
|
|||
|
|
@ -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 ();
|
||||
}
|
||||
Loading…
Reference in New Issue