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

mescc: Support function-static variables.

Browse source 
* 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 2018-05-04 20:45:27 +02:00
parent 1cd97f1172
commit be60b3e49b
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
7 changed files with 170 additions and 66 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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

126
module/language/c99/compiler.mes
View file

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

1
module/language/c99/compiler.scm
View file

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

4
module/language/c99/info.mes
View file

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

22
module/language/c99/info.scm
View file

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

48
module/mes/M1.mes
View file

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

34
scaffold/tests/46-function-static.c Normal file
View file

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