Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding a --features command-line option to chibi-ffi and chibi-genstatic.

Browse source 
Needed for cross-compiling.
This commit is contained in:
Alex Shinn 2015-01-04 23:31:41 -05:00
parent 8dedc36609
commit 94002d2134
2 changed files with 98 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

102
tools/chibi-ffi
View file

@ -1955,42 +1955,66 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; main ;; main
(let* ((args (command-line)) (let ((args (command-line)))
(args (if (pair? args) (cdr args) args)) (let lp ((args (if (pair? args) (cdr args) args))
(compile? (and (pair? args) (member (car args) '("-c" "--compile")))) (compile? #f)
(args (if compile? (cdr args) args)) (cflags '())
(cflags (if (and (pair? args) (member (car args) '("-f" "--flags"))) (features '()))
(string-split (cadr args) #\space) (cond
#f)) ((and (pair? args) (not (equal? "" (car args)))
(args (if cflags (cddr args) args)) (eqv? #\- (string-ref (car args) 0)))
(src (if (or (not (pair? args)) (equal? "-" (car args))) (case (string->symbol (car args))
"/dev/stdin" ((-c --compile)
(car args))) (lp (cdr args) #t cflags features))
(dest ((-f --flags)
(case (length args) (if (null? (cdr args))
((0) "-") (error "--flags requires an argument"))
((1) (string-append (strip-extension src) ".c")) (lp (cddr args)
((2) (cadr args)) compile?
(else (error "usage: chibi-ffi [-c] <file.stub> [<output.c>]"))))) (append cflag (string-split (cadr args) #\space))
(if (not (equal? "/dev/stdin" src)) features))
(let ((slash (string-scan-right src #\/))) ((--features)
(if (> slash 0) (if (null? (cdr args))
(set! wdir (substring-cursor src 0 slash))))) (error "--features requires an argument"))
(if (equal? "-" dest) (lp (cddr args)
(generate src) compile?
(with-output-to-file dest (lambda () (generate src)))) cflags
(cond (append features (string-split (cadr args) #\,))))
((and compile? (not (equal? "-" dest))) (else
;; This has to use `eval' for bootstrapping, since we need (error "unknown option" (car args)))))
;; chibi-ffi to compile to (chibi process) module. (else
(let* ((so (string-append (strip-extension src) (if (pair? features)
*shared-object-extension*)) (set! *features* features))
(execute (begin (eval '(import (chibi process))) (let* ((src (if (or (not (pair? args)) (equal? "-" (car args)))
(eval 'execute))) "/dev/stdin"
(base-args (append (or cflags '()) (car args)))
`("-o" ,so ,dest "-lchibi-scheme"))) (dest
(args (cond-expand (case (length args)
(macosx (append '("-dynamiclib" "-Oz") base-args)) ((0) "-")
(else (append '("-fPIC" "-shared" "-Os") base-args)))) ((1) (string-append (strip-extension src) ".c"))
(cc (if *c++?* "c++" "cc"))) ((2) (cadr args))
(execute cc (cons cc args)))))) (else
(error "usage: chibi-ffi [-c] <file.stub> [<output.c>]")))))
(if (not (equal? "/dev/stdin" src))
(let ((slash (string-scan-right src #\/)))
(if (> slash 0)
(set! wdir (substring-cursor src 0 slash)))))
(if (equal? "-" dest)
(generate src)
(with-output-to-file dest (lambda () (generate src))))
(cond
((and compile? (not (equal? "-" dest)))
;; This has to use `eval' for bootstrapping, since we need
;; chibi-ffi to compile to (chibi process) module.
(let* ((so (string-append (strip-extension src)
*shared-object-extension*))
(execute (begin (eval '(import (chibi process)))
(eval 'execute)))
(base-args (append cflags `("-o" ,so ,dest "-lchibi-scheme")))
(args
(eval
'(cond-expand
(macosx (append '("-dynamiclib" "-Oz") base-args))
(else (append '("-fPIC" "-shared" "-Os") base-args)))))
(cc (if *c++?* "c++" "cc")))
(execute cc (cons cc args))))))))))

55
tools/chibi-genstatic
View file

@ -358,23 +358,38 @@
(display (init-name (cdr lib))) (display (init-name (cdr lib)))
(display " },\n")) (display " },\n"))
(let* ((args (command-line)) (let ((args (command-line)))
(_ (if (pair? args) (if (pair? args)
(set! wdir (path-directory (path-directory (car args)))))) (set! wdir (path-directory (path-directory (car args)))))
(c-libs+c-files (find-c-libs (if (pair? args) (cdr args) args))) (let lp ((args (if (pair? args) (cdr args) args))
(c-libs (car c-libs+c-files)) (features '()))
(c-files (cdr c-libs+c-files)) (cond
(inline? #t)) ((and (pair? args) (not (equal? "" (car args)))
(newline) (eqv? #\- (string-ref (car args) 0)))
(for-each (lambda (x) (include-c-lib x c-files inline?)) c-libs) (case (string->symbol (car args))
(newline) ((--features)
;; (display "typedef struct {\n") (if (null? (cdr args))
;; (display " const char *name;\n") (error "--features requires an argument"))
;; (display " sexp_init_proc init;\n") (lp (cddr args) (append features (string-split (cadr args) #\,))))
;; (display "} sexp_library_entry_t;\n") (else
;; (newline) (error "unknown option" (car args)))))
(display "struct sexp_library_entry_t sexp_static_libraries_array[] = {\n") (else
(for-each init-c-lib c-libs) (if (pair? features)
(display " { NULL, NULL }\n") (set! *features* features))
(display "};\n\n") (let* ((c-libs+c-files (find-c-libs (if (pair? args) (cdr args) args)))
(display "struct sexp_library_entry_t* sexp_static_libraries = sexp_static_libraries_array;\n")) (c-libs (car c-libs+c-files))
(c-files (cdr c-libs+c-files))
(inline? #t))
(newline)
(for-each (lambda (x) (include-c-lib x c-files inline?)) c-libs)
(newline)
;; (display "typedef struct {\n")
;; (display " const char *name;\n")
;; (display " sexp_init_proc init;\n")
;; (display "} sexp_library_entry_t;\n")
;; (newline)
(display "struct sexp_library_entry_t sexp_static_libraries_array[] = {\n")
(for-each init-c-lib c-libs)
(display " { NULL, NULL }\n")
(display "};\n\n")
(display "struct sexp_library_entry_t* sexp_static_libraries = sexp_static_libraries_array;\n"))))))