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

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

Browse source 
* 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 ;;; 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. ;;; This file is part of GNU Mes.
;;; ;;;
@ -223,7 +223,7 @@
(string-label (string->label label)) (string-label (string->label label))
(string? (not (equal? string-label "_string_#f")))) (string? (not (equal? string-label "_string_#f"))))
(cond ((and (pair? o) (global? (cdr o))) (string-append "&" (global->string o))) (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 ((equal? string-label "%0") o) ;; FIXME: 64b
(else (string-append "&" label)))))) (else (string-append "&" label))))))
(define (display-align size) (define (display-align size)

30
module/mescc/compile.scm
View file

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

17
module/mescc/mescc.scm
View file

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

18
module/mescc/preprocess.scm
View file

@ -1,5 +1,5 @@
;;; GNU Mes --- Maxwell Equations of Software ;;; 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. ;;; This file is part of GNU Mes.
;;; ;;;
@ -69,16 +69,6 @@
(mes (mes
(insert-progress-monitors c99-act-v c99-len-v))) (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?) (define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
(let* ((sys-include (if (equal? prefix "") "include" (let* ((sys-include (if (equal? prefix "") "include"
(string-append prefix "/include"))) (string-append prefix "/include")))
@ -102,8 +92,8 @@
,(if mes-or-reproducible? "__MESC_MES__=1" "__MESC_MES__=0") ,(if mes-or-reproducible? "__MESC_MES__=1" "__MESC_MES__=0")
,@defines))) ,@defines)))
(when (and verbose? (> verbose? 1)) (when (and verbose? (> verbose? 1))
(stderr "includes: ~s\n" includes) (format (current-error-port) "includes: ~s\n" includes)
(stderr "defines: ~s\n" defines)) (format (current-error-port) "defines: ~s\n" defines))
(parse-c99 (parse-c99
#:inc-dirs includes #:inc-dirs includes
#:cpp-defs defines #:cpp-defs defines
@ -111,7 +101,7 @@
(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?) (define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?)
(when verbose? (when verbose?
(stderr "parsing: input\n")) (format (current-error-port) "parsing: input\n"))
((compose ast-strip-attributes ((compose ast-strip-attributes
ast-strip-const ast-strip-const
ast-strip-comment) ast-strip-comment)