#lang mzscheme (require make dynext/link dynext/compile dynext/file mzlib/file mzlib/list mzlib/etc launcher compiler/xform setup/dirs) (provide pre-install) ;; 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 (main-collects-parent-dir 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 main-collects-parent-dir 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)) (define avail (available-mzscheme-variants)) ;; Maybe do CGC mode: (when (or (memq 'cgc avail) (and (memq 'normal avail) (eq? 'cgc (system-type 'gc)))) (parameterize ([link-variant 'cgc]) (go file.c #f))) ;; Maybe do 3m mode: (when (and 3m-too? (or (memq '3m avail) (and (memq 'normal avail) (eq? '3m (system-type 'gc))))) (parameterize ([link-variant '3m]) (let ([3m-dir (build-path collection-dir "compiled" "native" (system-library-subpath '3m))]) (make-directory* 3m-dir) (go (build-path 3m-dir (let-values ([(base name dir?) (split-path file.c)]) name)) file.c)))))) (define (pre-install/check-precompiled main-collects-parent-dir collection-dir file.c . rest) (let* ([pre-dir (build-path collection-dir "precompiled" "native")] [variant-dir (system-library-subpath (link-variant))] [base-file (string-append (path-element->string (extract-base-filename file.c)) "_ss")] [file.so (build-path pre-dir variant-dir (append-extension-suffix base-file))]) (if (file-exists? file.so) ;; Just copy pre-compiled file: (let* ([dest-dir (build-path collection-dir "compiled" "native" variant-dir)] [dest-file.so (build-path dest-dir (append-extension-suffix base-file))]) (make-directory* dest-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 main-collects-parent-dir collection-dir file.c rest)))) (define (pre-install/normal main-collects-parent-dir 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" ;; OS X DarwinPorts location: "/opt/local" ;; 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 (find-include-dir)) (define headers (map (lambda (name) (build-path mz-inc-dir name)) '("scheme.h" "schvers.h" "schemef.h" "sconfig.h" "stypes.h"))) (define dir (build-path "compiled" "native" (system-library-subpath (link-variant)))) (define base-file (string-append (path-element->string (extract-base-filename file.c)) "_ss")) (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 ((current-make-compile-include-strings) (build-path sys-path "include"))] [current-extension-preprocess-flags ((current-make-compile-include-strings) (build-path sys-path "include"))] ;; Add -L and -l for Unix: [current-extension-linker-flags (if is-win? null (list (format "-L~a/lib" (path->string sys-path))))] ;; Add libs for Windows: [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: [current-extension-linker-flags (case mach-id [(rs6k-aix) (list "-lc")] [else null])] [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 (if (path? xform-src.c) (path->string xform-src.c) 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)) #())))))))