From a551d9dcde151be3108d79e18668e9ce56fbdfb7 Mon Sep 17 00:00:00 2001 From: "Jan (janneke) Nieuwenhuizen" Date: Wed, 30 Dec 2020 21:20:19 +0100 Subject: [PATCH] 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. --- module/mescc/M1.scm | 4 ++-- module/mescc/compile.scm | 30 +++++++++++++++--------------- module/mescc/mescc.scm | 17 +++++++++-------- module/mescc/preprocess.scm | 18 ++++-------------- 4 files changed, 30 insertions(+), 39 deletions(-) diff --git a/module/mescc/M1.scm b/module/mescc/M1.scm index d7a9b1d6..790ef881 100644 --- a/module/mescc/M1.scm +++ b/module/mescc/M1.scm @@ -1,5 +1,5 @@ ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2020 Jan (janneke) Nieuwenhuizen ;;; ;;; 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) diff --git a/module/mescc/compile.scm b/module/mescc/compile.scm index 579de2ce..d9276d81 100644 --- a/module/mescc/compile.scm +++ b/module/mescc/compile.scm @@ -1,5 +1,5 @@ ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2019,2020 Jan (janneke) Nieuwenhuizen ;;; ;;; 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)) diff --git a/module/mescc/mescc.scm b/module/mescc/mescc.scm index c52ff6b8..ef7e22d7 100644 --- a/module/mescc/mescc.scm +++ b/module/mescc/mescc.scm @@ -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)) diff --git a/module/mescc/preprocess.scm b/module/mescc/preprocess.scm index c8bfa511..375ac3bd 100644 --- a/module/mescc/preprocess.scm +++ b/module/mescc/preprocess.scm @@ -1,5 +1,5 @@ ;;; GNU Mes --- Maxwell Equations of Software -;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2016,2017,2018,2020 Jan (janneke) Nieuwenhuizen ;;; ;;; 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)