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

mescc: Add <include>/<kernel>/<arch> to include path.

Browse source 
* module/mescc/preprocess.scm (c99-input->full-ast): Add
<include>/<kernel>/<arch> to include path.
* module/mescc/compile.scm (c99-input->info): Pass arch.
* module/mescc/mescc.scm (mescc:preprocess): Likewise.
(c->info): Likewise.
(c->ast): Likewise.
This commit is contained in:
Jan Nieuwenhuizen 2019-07-26 22:44:04 +02:00
parent 2197252482
commit af1cc3ce81
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
3 changed files with 24 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
module/mescc/compile.scm
View file

@ -49,8 +49,8 @@
(if %reduced-register-count %reduced-register-count
(length (append (.registers info) (.allocated info)))))
(define* (c99-input->info info #:key (prefix "") (defines '()) (includes '()))
(let ((ast (c99-input->ast #:prefix prefix #:defines defines #:includes includes)))
(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)

13
module/mescc/mescc.scm
View file

@ -54,14 +54,14 @@
(includes (cons dir includes))
(prefix (option-ref options 'prefix ""))
(machine (option-ref options 'machine "32"))
(arch (if (equal? machine "32") "__i386__=1" "__x86_64__=1"))
(arch (arch-get options))
(defines (cons (arch-get-define options) defines)))
(with-output-to-file ast-file-name
(lambda _ (for-each (cut c->ast prefix defines includes pretty-print/write <>) files)))))
(lambda _ (for-each (cut c->ast prefix defines includes arch pretty-print/write <>) files)))))
(define (c->ast prefix defines includes write file-name)
(define (c->ast prefix defines includes arch write file-name)
(with-input-from-file file-name
(cut write (c99-input->ast #:prefix prefix #:defines defines #:includes includes))))
(cut write (c99-input->ast #:prefix prefix #:defines defines #:includes includes #:arch arch))))
(define (mescc:compile options)
(let* ((files (option-ref options '() '("a.c")))
@ -89,9 +89,10 @@
(dir (dirname file-name))
(includes (cons dir includes))
(prefix (option-ref options 'prefix ""))
(defines (cons (arch-get-define options) defines)))
(defines (cons (arch-get-define options) defines))
(arch (arch-get options)))
(with-input-from-file file-name
(cut c99-input->info (arch-get-info options) #:prefix prefix #:defines defines #:includes includes))))
(cut c99-input->info (arch-get-info options) #:prefix prefix #:defines defines #:includes includes #:arch arch))))
(define (E->info options file-name)
(let ((ast (with-input-from-file file-name read)))

20
module/mescc/preprocess.scm
View file

@ -77,10 +77,20 @@
(define mes? (pair? (current-module)))
(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()))
(let ((sys-include (if (equal? prefix "") "include" (string-append prefix "/share/include"))))
(define* (c99-input->full-ast #:key (prefix "") (defines '()) (includes '()) (arch ""))
(let* ((sys-include (if (equal? prefix "") "include"
(string-append prefix "/include")))
(kernel "linux")
(kernel-include (string-append sys-include "/" kernel "/" arch)))
(parse-c99
#:inc-dirs (append includes (cons* sys-include "include" "lib" (or (and=> (getenv "C_INCLUDE_PATH") (cut string-split <> #\:)) '())))
#: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"
@ -92,9 +102,9 @@
,@defines)
#:mode 'code)))
(define* (c99-input->ast #:key (prefix "") (defines '()) (includes '()))
(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)))
((compose ast-strip-const ast-strip-comment) (c99-input->full-ast #:prefix prefix #:defines defines #:includes includes #:arch arch)))
(define (ast-strip-comment o)
(pmatch o