From c03807b78f161605a48efad3d5f878d2ce4bae9f Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sat, 27 Jul 2019 09:51:21 +0200 Subject: [PATCH] mescc: Be silent. * module/mescc/M1.scm (infos->M1, info->M1): Add verbose?. Move debugging into verbose? > 1. * module/mescc/compile.scm (c99-input->info, c99-ast->info): Likewise. (mescc:trace-verbose): Rename from mescc:trace. (mescc:trace): New function. * module/mescc.scm (mescc:main): Likewise. * module/mescc/mescc.scm (mescc:preprocess, c->ast mescc:compile, c->info, E->info): Likewise. * module/mescc/preprocess.scm (c99-input->full-ast, c99-input->ast): Likewise. --- module/mescc.scm | 5 ++-- module/mescc/M1.scm | 19 ++++++++------ module/mescc/compile.scm | 17 ++++++++----- module/mescc/mescc.scm | 50 +++++++++++++++++++++---------------- module/mescc/preprocess.scm | 50 +++++++++++++++++++++---------------- 5 files changed, 82 insertions(+), 59 deletions(-) diff --git a/module/mescc.scm b/module/mescc.scm index 4ba658e4..36696d76 100644 --- a/module/mescc.scm +++ b/module/mescc.scm @@ -158,10 +158,11 @@ General help using GNU software: (preprocess? (option-ref options 'preprocess #f)) (compile? (option-ref options 'compile #f)) (assemble? (option-ref options 'assemble #f)) - (verbose? (option-ref options 'verbose (getenv "MES_DEBUG")))) + (verbose? (count-opt options 'verbose))) (when verbose? (setenv "NYACC_TRACE" "yes") - (format (current-error-port) "options=~s\n" options)) + (when (> verbose? 1) + (format (current-error-port) "options=~s\n" options))) (cond (dumpmachine? (display (mescc:get-host options))) (preprocess? (mescc:preprocess options)) (compile? (mescc:compile options)) diff --git a/module/mescc/M1.scm b/module/mescc/M1.scm index 8dbbc304..4d59ee8d 100644 --- a/module/mescc/M1.scm +++ b/module/mescc/M1.scm @@ -35,9 +35,9 @@ infos->M1 M1:merge-infos)) -(define* (infos->M1 file-name infos #:key align?) +(define* (infos->M1 file-name infos #:key align? verbose?) (let ((info (fold M1:merge-infos (make ) infos))) - (info->M1 file-name info #:align? align?))) + (info->M1 file-name info #:align? align? #:verbose? verbose?))) (define (M1:merge-infos o info) (clone info @@ -100,7 +100,7 @@ (display sep)) (loop (cdr o))))) -(define* (info->M1 file-name o #:key align?) +(define* (info->M1 file-name o #:key align? verbose?) (let* ((functions (.functions o)) (function-names (map car functions)) (globals (.globals o)) @@ -186,7 +186,8 @@ (display-join (map text->M1 o) " ")) (else (error "line->M1 invalid line:" o))) (newline)) - (display (string-append " :" name "\n") (current-error-port)) + (when verbose? + (display (string-append " :" name "\n") (current-error-port))) (display (string-append "\n\n:" name "\n")) (for-each line->M1 (apply append text)))) (define (write-global o) @@ -212,8 +213,8 @@ ((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)))) + (foo (when (and verbose? (not (eq? (car (string->list label)) #\_))) + (display (string-append " :" label "\n") (current-error-port)))) (data ((compose global:value cdr) o)) (data (filter-map labelize data)) (len (length data)) @@ -236,10 +237,12 @@ (display-join text " ") (display-align (length text)))) (newline))) - (display "M1: functions\n" (current-error-port)) + (when verbose? + (display "M1: functions\n" (current-error-port))) (for-each write-function (filter cdr functions)) (when (assoc-ref functions "main") (display "\n\n:ELF_data\n") ;; FIXME (display "\n\n:HEX2_data\n")) - (display "M1: globals\n" (current-error-port)) + (when verbose? + (display "M1: globals\n" (current-error-port))) (for-each write-global globals))) diff --git a/module/mescc/compile.scm b/module/mescc/compile.scm index ff912566..22c5968e 100644 --- a/module/mescc/compile.scm +++ b/module/mescc/compile.scm @@ -49,12 +49,14 @@ (if %reduced-register-count %reduced-register-count (length (append (.registers info) (.allocated info))))) -(define* (c99-input->info info #:key (prefix "") (defines '()) (includes '()) (arch "")) - (let ((ast (c99-input->ast #:prefix prefix #:defines defines #:includes includes #:arch arch))) - (c99-ast->info info ast))) +(define* (c99-input->info info #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?) + (let ((ast (c99-input->ast #:prefix prefix #:defines defines #:includes includes #:arch arch #:verbose? verbose?))) + (c99-ast->info info ast #:verbose? verbose?))) -(define* (c99-ast->info info o) - (stderr "compiling: input\n") +(define* (c99-ast->info info o #:key verbose?) + (when verbose? + (stderr "compiling: input\n") + (set! mescc:trace mescc:trace-verbose)) (let ((info (ast->info o info))) (clean-info info))) @@ -427,9 +429,12 @@ (define (make-local-entry name type id) (cons name (make-local name type id))) -(define* (mescc:trace name #:optional (type "")) +(define* (mescc:trace-verbose name #:optional (type "")) (format (current-error-port) " :~a~a\n" name type)) +(define* (mescc:trace name #:optional (type "")) + #t) + (define (expr->arg o i info) (pmatch o ((p-expr (string ,string)) diff --git a/module/mescc/mescc.scm b/module/mescc/mescc.scm index a9eecc00..2660a452 100644 --- a/module/mescc/mescc.scm +++ b/module/mescc/mescc.scm @@ -28,11 +28,13 @@ #:use-module (mescc preprocess) #:use-module (mescc compile) #:use-module (mescc M1) - #:export (mescc:preprocess + #:export (count-opt + mescc:preprocess mescc:get-host mescc:compile mescc:assemble - mescc:link)) + mescc:link + multi-opt)) (define GUILE-with-output-to-file with-output-to-file) (define (with-output-to-file file-name thunk) @@ -55,13 +57,14 @@ (prefix (option-ref options 'prefix "")) (machine (option-ref options 'machine "32")) (arch (arch-get options)) - (defines (cons (arch-get-define options) defines))) + (defines (cons (arch-get-define options) defines)) + (verbose? (count-opt options 'verbose))) (with-output-to-file ast-file-name - (lambda _ (for-each (cut c->ast prefix defines includes arch pretty-print/write <>) files))))) + (lambda _ (for-each (cut c->ast prefix defines includes arch pretty-print/write verbose? <>) files))))) -(define (c->ast prefix defines includes arch write file-name) +(define (c->ast prefix defines includes arch write verbose? file-name) (with-input-from-file file-name - (cut write (c99-input->ast #:prefix prefix #:defines defines #:includes includes #:arch arch)))) + (cut write (c99-input->ast #:prefix prefix #:defines defines #:includes includes #:arch arch #:verbose? verbose?)))) (define (mescc:compile options) (let* ((files (option-ref options '() '("a.c"))) @@ -71,12 +74,12 @@ (option-ref options 'output #f))) (else (replace-suffix input-base ".s")))) (infos (map (cut file->info options <>) files)) - (verbose? (option-ref options 'verbose #f)) + (verbose? (count-opt options 'verbose)) (align? (option-ref options 'align #f))) (when verbose? (stderr "dumping: ~a\n" 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? #:verbose? verbose?)) M1-file-name)) (define (file->info options file-name) @@ -90,13 +93,15 @@ (includes (cons dir includes)) (prefix (option-ref options 'prefix "")) (defines (cons (arch-get-define options) defines)) - (arch (arch-get options))) + (arch (arch-get options)) + (verbose? (count-opt options 'verbose))) (with-input-from-file file-name - (cut c99-input->info (arch-get-info options) #:prefix prefix #:defines defines #:includes includes #:arch arch)))) + (cut c99-input->info (arch-get-info options) #:prefix prefix #:defines defines #:includes includes #:arch arch #:verbose? verbose?)))) (define (E->info options file-name) - (let ((ast (with-input-from-file file-name read))) - (c99-ast->info (arch-get-info options) ast))) + (let ((ast (with-input-from-file file-name read)) + (verbose? (count-opt options 'verbose))) + (c99-ast->info (arch-get-info options) ast #:verbose? verbose?))) (define (mescc:assemble options) (let* ((files (option-ref options '() '("a.c"))) @@ -155,7 +160,7 @@ (M1-file-name (replace-suffix hex2-file-name ".s")) (options (acons 'compile #t options)) ; ugh (options (acons 'output hex2-file-name options)) - (verbose? (option-ref options 'verbose #f)) + (verbose? (count-opt options 'verbose)) (align? (option-ref options 'align #f))) (when verbose? (stderr "dumping: ~a\n" M1-file-name)) @@ -173,7 +178,7 @@ ((option-ref options 'assemble #f) (replace-suffix input-base ".o")) (else (replace-suffix M1-file-name ".o")))) - (verbose? (option-ref options 'verbose #f)) + (verbose? (count-opt options 'verbose)) (M1 (or (getenv "M1") "M1")) (command `(,M1 "--LittleEndian" @@ -181,7 +186,7 @@ "-f" ,(arch-find options (arch-get-m1-macros options)) ,@(append-map (cut list "-f" <>) M1-files) "-o" ,hex2-file-name))) - (when verbose? + (when (and verbose? (> verbose? 1)) (stderr "~a\n" (string-join command))) (and (zero? (apply assert-system* command)) hex2-file-name))) @@ -190,7 +195,7 @@ (let* ((input-file-name (car (option-ref options '() '("a.c")))) (elf-file-name (cond ((option-ref options 'output #f)) (else "a.out"))) - (verbose? (option-ref options 'verbose #f)) + (verbose? (count-opt options 'verbose)) (hex2 (or (getenv "HEX2") "hex2")) (base-address (option-ref options 'base-address "0x1000000")) (machine (arch-get-machine options)) @@ -210,7 +215,7 @@ "-f" ,elf-footer "--exec_enable" "-o" ,elf-file-name))) - (when verbose? + (when (and verbose? (> verbose? 1)) (stderr "~a\n" (string-join command))) (and (zero? (apply assert-system* command)) elf-file-name))) @@ -220,13 +225,13 @@ (M1-blood-elf-footer (string-append M1-file-name ".blood-elf")) (hex2-file-name (replace-suffix M1-file-name ".o")) (blood-elf-footer (string-append hex2-file-name ".blood-elf")) - (verbose? (option-ref options 'verbose #f)) + (verbose? (count-opt options 'verbose)) (blood-elf (or (getenv "BLOOD_ELF") "blood-elf")) (command `(,blood-elf "-f" ,(arch-find options (arch-get-m1-macros options)) ,@(append-map (cut list "-f" <>) M1-files) "-o" ,M1-blood-elf-footer))) - (when verbose? + (when (and verbose? (> verbose? 1)) (format (current-error-port) "~a\n" (string-join command))) (and (zero? (apply assert-system* command)) (let* ((options (acons 'compile #t options)) ; ugh @@ -258,9 +263,9 @@ (prefix-file options "lib") (filter-map (multi-opt 'library-dir) options))) (arch-file-name (string-append arch "/" file-name)) - (verbose? (option-ref options 'verbose #f))) + (verbose? (count-opt options 'verbose))) (let ((file (search-path path arch-file-name))) - (when verbose? + (when (and verbose? (> verbose? 1)) (stderr "arch-find=~s\n" arch-file-name) (stderr " path=~s\n" path) (stderr " => ~s\n" file)) @@ -325,6 +330,9 @@ ((equal? arch "x86_64") "amd64")))) (define (multi-opt option-name) (lambda (o) (and (eq? (car o) option-name) (cdr o)))) +(define (count-opt options option-name) + (let ((lst (filter-map (multi-opt option-name) options))) + (and (pair? lst) (length lst)))) (define (.c? o) (or (string-suffix? ".c" o) (string-suffix? ".M2" o))) diff --git a/module/mescc/preprocess.scm b/module/mescc/preprocess.scm index 935e98e3..c7327a44 100644 --- a/module/mescc/preprocess.scm +++ b/module/mescc/preprocess.scm @@ -77,34 +77,40 @@ (define mes? (pair? (current-module))) -(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()) (arch "")) +(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?) (let* ((sys-include (if (equal? prefix "") "include" (string-append prefix "/include"))) (kernel "linux") - (kernel-include (string-append sys-include "/" kernel "/" arch))) + (kernel-include (string-append sys-include "/" kernel "/" arch)) + (includes (append + includes + (cons* kernel-include + sys-include + (append (or (and=> (getenv "CPATH") + (cut string-split <> #\:)) '()) + (or (and=> (getenv "C_INCLUDE_PATH") + (cut string-split <> #\:)) '()))))) + (defines `( + "NULL=0" + "__linux__=1" + "_POSIX_SOURCE=0" + "SYSTEM_LIBC=0" + "__STDC__=1" + "__MESC__=1" + ,(if mes? "__MESC_MES__=1" "__MESC_MES__=0") + ,@defines))) + (when (and verbose? (> verbose? 1)) + (stderr "includes: ~s\n" includes) + (stderr "defines: ~s\n" defines)) (parse-c99 - #:inc-dirs (append - includes - (cons* kernel-include - sys-include - (append (or (and=> (getenv "CPATH") - (cut string-split <> #\:)) '()) - (or (and=> (getenv "C_INCLUDE_PATH") - (cut string-split <> #\:)) '())))) - #:cpp-defs `( - "NULL=0" - "__linux__=1" - "_POSIX_SOURCE=0" - "SYSTEM_LIBC=0" - "__STDC__=1" - "__MESC__=1" - ,(if mes? "__MESC_MES__=1" "__MESC_MES__=0") - ,@defines) + #:inc-dirs includes + #:cpp-defs defines #:mode 'code))) -(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()) (arch "")) - (stderr "parsing: input\n") - ((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:prefix prefix #:defines defines #:includes includes #:arch arch))) +(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()) (arch "") verbose?) + (when verbose? + (stderr "parsing: input\n")) + ((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:prefix prefix #:defines defines #:includes includes #:arch arch #:verbose? verbose?))) (define (ast-strip-comment o) (pmatch o