(module setup-extension mzscheme (require (lib "make.ss" "make") (lib "link.ss" "dynext") (lib "compile.ss" "dynext") (lib "file.ss" "dynext") (lib "file.ss") (lib "list.ss") (lib "process.ss") (lib "etc.ss") (lib "launcher.ss" "launcher") (lib "xform.ss" "compiler") (rename (lib "plthome.ss" "setup") plthome* plthome)) (provide pre-install with-new-flags) ;; Syntax used to add a command-line flag: (define-syntax with-new-flags (syntax-rules () [(_ param flags body0 body ...) (parameterize ([param (append (param) flags)]) body0 body ...)])) (define (extract-base-filename file.c) (let-values ([(base name dir?) (split-path (extract-base-filename/c file.c 'pre-install))]) name)) (define (string-path->string s) (if (string? s) s (path->string s))) (define pre-install (opt-lambda (plthome collection-dir file.c default-lib-dir include-subdirs find-unix-libs find-windows-libs unix-libs windows-libs extra-depends last-chance-k [3m-too? #f]) ;; Compile and link one file: (define (go file.c xform-src.c) (pre-install/check-precompiled plthome collection-dir file.c default-lib-dir include-subdirs find-unix-libs find-windows-libs unix-libs windows-libs extra-depends last-chance-k xform-src.c)) ;; Do normal mode: (go file.c #f) ;; Maybe do 3m mode: (when (and 3m-too? (memq '3m (available-mzscheme-variants))) (let ([3m-dir (build-path collection-dir "compiled" "native" (system-library-subpath #f) "3m")]) (make-directory* 3m-dir) (parameterize ([link-variant '3m]) (go (build-path 3m-dir (let-values ([(base name dir?) (split-path file.c)]) name)) file.c)))))) (define (pre-install/check-precompiled plthome collection-dir file.c . rest) (let* ([base-dir (build-path collection-dir "precompiled" "native" (system-library-subpath #f))] [variant-dir (case (link-variant) [(3m) (build-path base-dir "3m")] [else base-dir])] [base-file (extract-base-filename file.c)] [file.so (build-path variant-dir (append-extension-suffix base-file))]) (if (file-exists? file.so) ;; Just copy pre-compiled file: (let* ([base-dir (build-path collection-dir "compiled" "native" (system-library-subpath #f))] [variant-dir (case (link-variant) [(3m) (build-path base-dir "3m")] [else base-dir])] [dest-file.so (build-path variant-dir (append-extension-suffix base-file))]) (make-directory* variant-dir) (printf " Copying ~a~n to ~a~n" file.so dest-file.so) (when (file-exists? dest-file.so) (delete-file dest-file.so)) (copy-file file.so dest-file.so)) ;; Normal build... (apply pre-install/normal plthome collection-dir file.c rest)))) (define (pre-install/normal plthome collection-dir file.c default-lib-dir include-subdirs find-unix-libs find-windows-libs unix-libs windows-libs extra-depends last-chance-k xform-src.c) (parameterize ([current-directory collection-dir]) (define mach-id (string->symbol (path->string (system-library-subpath #f)))) (define is-win? (eq? mach-id 'win32\\i386)) ;; We look for libraries and includes in the ;; following places: (define search-path (append (let ([v (getenv "PLT_EXTENSION_LIB_PATHS")]) (if v (path-list-string->path-list v (list default-lib-dir)) (list default-lib-dir))) (list "/usr" "/usr/local" "/usr/local/gnu" ;; OS X fink location: "/sw" ;; Hack for NU PLT's convenience: "/arch/gnu/packages/readline-4.2"))) (define sys-path (ormap (lambda (x) (and (andmap (lambda (sub) (directory-exists? (build-path x "include" sub))) include-subdirs) (andmap (lambda (lib) (ormap (lambda (suffix) (file-exists? (build-path x "lib" (format "~a~a.~a" (if is-win? "" "lib") lib suffix)))) '("a" "so" "dylib" "lib"))) (if is-win? find-windows-libs find-unix-libs)) (if (string? x) (string->path x) x))) search-path)) (unless sys-path (error 'extension-installer "can't find needed include files and/or library; try setting the environment variable PLT_EXTENSION_LIB_PATHS")) (parameterize ([make-print-checking #f]) ;; Used as make dependencies: (define mz-inc-dir (build-path plthome* "include")) (define headers (map (lambda (name) (build-path mz-inc-dir name)) '("scheme.h" "schvers.h" "schemef.h" "sconfig.h" "stypes.h"))) (define dir (let ([std (build-path "compiled" "native" (system-library-subpath #f))]) (case (link-variant) [(3m) (build-path std "3m")] [else std]))) (define base-file (extract-base-filename file.c)) (define file.so (build-path dir (append-extension-suffix base-file))) (define file.o (build-path dir (append-object-suffix base-file))) (with-new-flags current-extension-compiler-flags (list (format "-I~a" (path->string (build-path sys-path "include")))) (with-new-flags current-extension-preprocess-flags (list (format "-I~a" (path->string (build-path sys-path "include")))) ;; Add -L and -l for Unix: (with-new-flags current-extension-linker-flags (if is-win? null (list (format "-L~a/lib" (path->string sys-path)))) ;; Add libs for Windows: (with-new-flags current-standard-link-libraries (if is-win? (append (map (lambda (l) (build-path sys-path "lib" (format "~a.lib" l))) find-windows-libs) windows-libs) null) ;; Extra stuff: (with-new-flags current-extension-linker-flags (case mach-id [(rs6k-aix) (list "-lc")] [else null]) (with-new-flags current-standard-link-libraries (case mach-id [(i386-cygwin) (list "-lc")] [else null]) (define (delete/continue x) (with-handlers ([(lambda (x) #t) void]) (delete-file x))) (make-directory* dir) (last-chance-k (lambda () (make/proc (append (list (list file.so (list file.o) (lambda () (link-extension #f (append (list file.o) (if is-win? null (map (lambda (l) (string-append "-l" (string-path->string l))) (append find-unix-libs unix-libs)))) file.so))) (list file.o (append (list file.c) (filter (lambda (x) (regexp-match #rx#"mzdyn[a-z0-9]*[.]o" (if (string? x) x (path->string x)))) (expand-for-link-variant (current-standard-link-libraries))) headers extra-depends) (lambda () (compile-extension #f file.c file.o null)))) (if xform-src.c (list (list file.c (append (list xform-src.c) headers extra-depends) (lambda () (xform #f xform-src.c file.c (list (let-values ([(base name dir?) (split-path xform-src.c)]) (if (path? base) base (current-directory))) mz-inc-dir))))) null)) #())))))))))))))