andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mescc: Use (format (current-error-port) ...) instead of stderr. 

* module/mescc/M1.scm: Use (format (current-error-port) ...) instead of
stderr.
* module/mescc/compile.scm: Likewise.
* module/mescc/mescc.scm: Likewise.
* module/mescc/preprocess.scm: Likewise.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-12-30 21:20:19 +01:00
parent a788fcfda7
commit a551d9dcde
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
4 changed files with 30 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
module/mescc/M1.scm
View File

@ -1,5 +1,5 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2017,2018,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Mes.
;;;
@ -223,7 +223,7 @@
(string-label (string->label label))
(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))
((and (not string?) (not function?)) (format (current-error-port) "warning: unresolved label: ~s\n" label))
((equal? string-label "%0") o) ;; FIXME: 64b
(else (string-append "&" label))))))
(define (display-align size)

30
module/mescc/compile.scm
View File

@ -1,5 +1,5 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Mes.
;;;
@ -56,7 +56,7 @@
(define* (c99-ast->info info o #:key verbose?)
(when verbose?
(stderr "compiling: input\n")
(format (current-error-port) "compiling: input\n")
(set! mescc:trace mescc:trace-verbose))
(let ((info (ast->info o info)))
(clean-info info)))
@ -107,7 +107,7 @@
(define (ast->type o info)
(define (type-helper o info)
(if (getenv "MESC_DEBUG")
(stderr "type-helper: ~s\n" o))
(format (current-error-port) "type-helper: ~s\n" o))
(pmatch o
(,t (guard (type? t)) t)
(,p (guard (pointer? p)) p)
@ -267,7 +267,7 @@
(define (ast-type->size info o)
(let ((type (->type (ast->type o info))))
(cond ((type? type) (type:size type))
(else (stderr "error: ast-type->size: ~s => ~s\n" o type)
(else (format (current-error-port) "error: ast-type->size: ~s => ~s\n" o type)
4))))
(define (field:name o)
@ -389,7 +389,7 @@
((function? var) (function:type var))
((assoc-ref (.constants info) o) (assoc-ref (.types info) "default"))
((pair? var) (car var))
(else (stderr "error: ident->type ~s => ~s\n" o var)
(else (format (current-error-port) "error: ident->type ~s => ~s\n" o var)
#f))))
(define (local:pointer o)
@ -504,7 +504,7 @@
((c-array? type) (c-array:type type))
((type? type) type)
(else
(stderr "unexpected type: ~s\n" type)
(format (current-error-port) "unexpected type: ~s\n" type)
type)))
(size (->size type* info))
(reg-size (->size "*" info))
@ -515,7 +515,7 @@
((2) (wrap-as (as info 'word-r->local+n id n)))
((4) (wrap-as (as info 'long-r->local+n id n)))
(else
(stderr "unexpected size:~s\n" size)
(format (current-error-port) "unexpected size:~s\n" size)
(wrap-as (as info 'r->local+n id n))))))
(define (r->ident info)
@ -1025,7 +1025,7 @@
(when (and (not (assoc name (.functions info)))
(not (assoc name globals))
(not (equal? name (.function info))))
(stderr "warning: undeclared function: ~a\n" name))
(format (current-error-port) "warning: undeclared function: ~a\n" name))
(append-text info (wrap-as (as info 'call-label name n))))
(let* ((info (expr->register `(p-expr (ident ,name)) info))
(info (append-text info (wrap-as (as info 'call-r n)))))
@ -1373,7 +1373,7 @@
(as info 'r0/r1 signed?)))))
(info (free-register info)))
info))
(else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*)" op type (ast->basic-type b info)))))))))
(else (error (format #f "invalid operands to binary ~s (have ~s* and ~s*) " op type (ast->basic-type b info)))))))))
(when (and (equal? op "=")
(not (= size size-b))
(not (and (or (= size 1) (= size 2))
@ -1384,8 +1384,8 @@
(= size-b reg-size)))
(not (and (= size reg-size)
(or (= size-b 1) (= size-b 2) (= size-b 4)))))
(stderr "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o))))
(stderr " size[~a]:~a != size[~a]:~a\n" rank size rank-b size-b))
(format (current-error-port) "ERROR assign: ~a" (with-output-to-string (lambda () (pretty-print-c99 o))))
(format (current-error-port) " size[~a]:~a != size[~a]:~a\n" rank size rank-b size-b))
(pmatch a
((p-expr (ident ,name))
(if (or (<= size r-size)
@ -2037,7 +2037,7 @@
(((decl-spec-list (stor-spec (,store)) (type-spec ,type)))
(type->info type #f info))
(((@ . _))
(stderr "decl->info: skip: ~s\n" o)
(format (current-error-port) "decl->info: skip: ~s\n" o)
info)
(_ (error "decl->info: not supported:" o))))
@ -2251,8 +2251,8 @@
(map (const '(fixed "0")) (iota missing)))))
(map (cut array-init-element->data (c-array:type type) <> info) inits)))
(else
(stderr "array-init-element->data: oops:~s\n" o)
(stderr "type:~s\n" type)
(format (current-error-port) "array-init-element->data: oops:~s\n" o)
(format (current-error-port) "type:~s\n" type)
(error "array-init-element->data: not supported: " o))))
(_ (init->data type o info))
(_ (error "array-init-element->data: not supported: " o))))
@ -2655,7 +2655,7 @@
(count (and=> local (compose local:id cdr)))
(reg-size (->size "*" info))
(stack (and count (* count reg-size))))
(if (and stack (getenv "MESC_DEBUG")) (stderr " stack: ~a\n" stack))
(if (and stack (getenv "MESC_DEBUG")) (format (current-error-port) " stack: ~a\n" stack))
(clone info
#:function #f
#:globals (append (.statics info) (.globals info))

17
module/mescc/mescc.scm
View File

@ -22,6 +22,7 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 pretty-print)
#:use-module (ice-9 getopt-long)
#:use-module (mes mes-0)
#:use-module (mes misc)
#:use-module (mescc info)
@ -87,7 +88,7 @@
;; function alignment not supported by MesCC-Tools 0.5.2
(filter (negate (cut eq? <> 'functions)) align))))
(when verbose?
(stderr "dumping: ~a\n" M1-file-name))
(format (current-error-port) "dumping: ~a\n" M1-file-name))
(with-output-to-file M1-file-name
(cut infos->M1 M1-file-name infos #:align align #:verbose? verbose?))
M1-file-name))
@ -181,7 +182,7 @@
;; function alignment not supported by MesCC-Tools 0.5.2
(filter (negate (cut eq? <> 'functions)) align))))
(when verbose?
(stderr "dumping: ~a\n" M1-file-name))
(format (current-error-port) "dumping: ~a\n" M1-file-name))
(with-output-to-file M1-file-name
(cut infos->M1 M1-file-name infos #:align align))
(or (M1->hex2 options (list M1-file-name))
@ -205,7 +206,7 @@
,@(append-map (cut list "-f" <>) M1-files)
"-o" ,hex2-file-name)))
(when (and verbose? (> verbose? 1))
(stderr "~a\n" (string-join command)))
(format (current-error-port) "~a\n" (string-join command)))
(and (zero? (apply assert-system* command))
hex2-file-name)))
@ -237,7 +238,7 @@
"-f" ,elf-footer
"-o" ,elf-file-name)))
(when (and verbose? (> verbose? 1))
(stderr "~a\n" (string-join command)))
(format (current-error-port) "~a\n" (string-join command)))
(and (zero? (apply assert-system* command))
elf-file-name)))
@ -300,9 +301,9 @@
(verbose? (count-opt options 'verbose)))
(let ((file (search-path path arch-file-name)))
(when (and verbose? (> verbose? 1))
(stderr "arch-find=~s\n" arch-file-name)
(stderr " path=~s\n" path)
(stderr " => ~s\n" file))
(format (current-error-port) "arch-find=~s\n" arch-file-name)
(format (current-error-port) " path=~s\n" path)
(format (current-error-port) " => ~s\n" file))
(or file
(error (format #f "mescc: file not found: ~s" arch-file-name))))))
@ -314,7 +315,7 @@
(define (assert-system* . args)
(let ((status (apply system* args)))
(when (not (zero? status))
(stderr "mescc: failed: ~a\n" (string-join args))
(format (current-error-port) "mescc: failed: ~a\n" (string-join args))
(exit (status:exit-val status)))
status))

18
module/mescc/preprocess.scm
View File

@ -1,5 +1,5 @@
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016,2017,2018,2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Mes.
;;;
@ -69,16 +69,6 @@
(mes
(insert-progress-monitors c99-act-v c99-len-v)))
(define (logf port string . rest)
(apply format (cons* port string rest))
(force-output port)
#t)
(define (stderr string . rest)
(apply logf (cons* (current-error-port) string rest)))
(define mes? (pair? (current-module)))
(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
(let* ((sys-include (if (equal? prefix "") "include"
(string-append prefix "/include")))
@ -102,8 +92,8 @@
,(if mes-or-reproducible? "__MESC_MES__=1" "__MESC_MES__=0")
,@defines)))
(when (and verbose? (> verbose? 1))
(stderr "includes: ~s\n" includes)
(stderr "defines: ~s\n" defines))
(format (current-error-port) "includes: ~s\n" includes)
(format (current-error-port) "defines: ~s\n" defines))
(parse-c99
#:inc-dirs includes
#:cpp-defs defines
@ -111,7 +101,7 @@
(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
(when verbose?
(stderr "parsing: input\n"))
(format (current-error-port) "parsing: input\n"))
((compose ast-strip-attributes
ast-strip-const
ast-strip-comment)