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