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

mescc: Be silent.

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2019-07-27 09:51:21 +02:00
parent af1cc3ce81
commit c03807b78f
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
5 changed files with 82 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
module/mescc.scm
View 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))

19
module/mescc/M1.scm
View 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
@ -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)))

17
module/mescc/compile.scm
View file

@ -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))

50
module/mescc/mescc.scm
View file

@ -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)))

50
module/mescc/preprocess.scm
View file

@ -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