mescc: Be silent.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 27 Jul 2019 07:51:21 +0000 (09:51 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 27 Jul 2019 07:51:21 +0000 (09:51 +0200)
* 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
module/mescc/M1.scm
module/mescc/compile.scm
module/mescc/mescc.scm
module/mescc/preprocess.scm

index 4ba658e4e022030b2eac10fa3d52097d973a7957..36696d766c8ae833ffcbd7f48d4fc6c1d4897a66 100644 (file)
@@ -158,10 +158,11 @@ General help using GNU software: <http://gnu.org/gethelp/>
          (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))
index 8dbbc304bf49219615fea0f136cf9203482fbda9..4d59ee8d9d50c3da41947507dd28342c6cd64447 100644 (file)
@@ -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 <info>) 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
           (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))
                  (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)
                      ((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))
               (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)))
index ff912566fccba4d473c18e2ce88e517401ac0ff5..22c5968ebd095eeb8c06da5af4814ed2d621717e 100644 (file)
   (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-ast->info info o)
-  (stderr "compiling: input\n")
+(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 #:key verbose?)
+  (when verbose?
+    (stderr "compiling: input\n")
+    (set! mescc:trace mescc:trace-verbose))
   (let ((info (ast->info o info)))
     (clean-info info)))
 
 (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))
index a9eecc00546cca3d428ceb82cd89a84bdbab23b9..2660a452332cbc3e5a5fa0e48541ffcf31681360 100644 (file)
   #: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)
          (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")))
                                    (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)
          (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")))
          (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))
                                ((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"
                     "-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)))
   (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))
                     "-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)))
          (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
                       (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))
           ((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)))
index 935e98e351d9397c11d0fa34b903f5de03771c36..c7327a44c9ad8eb11d73c357e78dc373e3a38bc0 100644 (file)
 
 (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