cygwin DLL build fixes

svn: r491
This commit is contained in:
Matthew Flatt 2005-07-28 21:49:16 +00:00
parent 239f354bc3
commit e6e64379d2
3 changed files with 96 additions and 64 deletions

View File

@ -52,9 +52,12 @@
;; Helpers to tell us about the selected linker in Windows: ;; Helpers to tell us about the selected linker in Windows:
(define (still-win-gcc?) (define (still-win-gcc?)
(and (eq? 'windows (system-type)) (or (and (eq? 'windows (system-type))
(let ([c (current-extension-linker)]) (let ([c (current-extension-linker)])
(and c (regexp-match #"ld.exe$" (path-string->string c)))))) (and c (regexp-match #"ld.exe$" (path-string->string c)))))
(and (eq? 'unix (system-type))
(string=? "i386-cygwin"
(path->string (system-library-subpath #f))))))
(define (still-win-borland?) (define (still-win-borland?)
(and (eq? 'windows (system-type)) (and (eq? 'windows (system-type))
(let ([c (current-extension-linker)]) (let ([c (current-extension-linker)])
@ -96,6 +99,10 @@
(lambda () (lambda ()
(if (current-use-mzdyn) (s) null))) (if (current-use-mzdyn) (s) null)))
(define msvc-linker-flags (list "/LD"))
(define win-gcc-linker-flags (list "--dll"))
(define borland-linker-flags (list "/Tpd" "/c"))
(define (get-unix-link-flags) (define (get-unix-link-flags)
(case (string->symbol (path->string (system-library-subpath #f))) (case (string->symbol (path->string (system-library-subpath #f)))
[(sparc-solaris i386-solaris) (list "-G")] [(sparc-solaris i386-solaris) (list "-G")]
@ -111,12 +118,9 @@
"-bnoentry")] "-bnoentry")]
[(parisc-hpux) (list "-b")] [(parisc-hpux) (list "-b")]
[(ppc-macosx ppc-darwin) (list "-bundle" "-flat_namespace" "-undefined" "suppress")] [(ppc-macosx ppc-darwin) (list "-bundle" "-flat_namespace" "-undefined" "suppress")]
[(i386-cygwin) win-gcc-linker-flags]
[else (list "-shared")])) [else (list "-shared")]))
(define msvc-linker-flags (list "/LD"))
(define win-gcc-linker-flags (list "--dll"))
(define borland-linker-flags (list "/Tpd" "/c"))
;; See doc.txt: ;; See doc.txt:
(define current-extension-linker-flags (define current-extension-linker-flags
(make-parameter (make-parameter
@ -159,7 +163,10 @@
(define current-make-link-output-strings (define current-make-link-output-strings
(make-parameter (make-parameter
(case (system-type) (case (system-type)
[(unix macosx) (lambda (s) (list "-o" (path-string->string s)))] [(unix macosx)
(case (string->symbol (path->string (system-library-subpath #f)))
[(i386-cygwin) win-gcc-link-output-strings]
[else (lambda (s) (list "-o" (path-string->string s)))])]
[(windows) (cond [(windows) (cond
[win-gcc? win-gcc-link-output-strings] [win-gcc? win-gcc-link-output-strings]
[win-borland? borland-link-output-strings] [win-borland? borland-link-output-strings]
@ -170,7 +177,7 @@
(raise-type-error 'current-make-link-output-strings "procedure of arity 1" p)) (raise-type-error 'current-make-link-output-strings "procedure of arity 1" p))
p))) p)))
(define (make-win-link-libraries win-gcc? win-borland?) (define (make-win-link-libraries win-gcc? win-borland? unix?)
(let* ([file (lambda (f) (let* ([file (lambda (f)
(path->string (path->string
(build-path std-library-dir (build-path std-library-dir
@ -192,12 +199,16 @@
(file (format s "xxxxxxx")))) (file (format s "xxxxxxx"))))
(f))))]) (f))))])
(cond (cond
[win-gcc? (list (wrap-xxxxxxx (wrap-3m "libmzsch~a~~a.lib")) [win-gcc? (append
(wrap-xxxxxxx (drop-3m "libmzgc~a.lib")) (if unix?
(mzdyn-maybe (filethunk (wrap-3m "mzdyn~a.exp"))) null
(mzdyn-maybe (filethunk (wrap-3m "mzdyn~a.o"))) (list (wrap-xxxxxxx (wrap-3m "libmzsch~a~~a.lib"))
(file "init.o") (wrap-xxxxxxx (drop-3m "libmzgc~a.lib"))))
(file "fixup.o"))] (list
(mzdyn-maybe (filethunk (wrap-3m "mzdyn~a.exp")))
(mzdyn-maybe (filethunk (wrap-3m "mzdyn~a.o")))
(file "init.o")
(file "fixup.o")))]
[win-borland? (map file (if (current-use-mzdyn) [win-borland? (map file (if (current-use-mzdyn)
(list "mzdynb.obj") (list "mzdynb.obj")
null))] null))]
@ -207,19 +218,23 @@
(mzdyn-maybe (filethunk (wrap-3m "mzdyn~a.obj"))))]))) (mzdyn-maybe (filethunk (wrap-3m "mzdyn~a.obj"))))])))
(define (get-unix/macos-link-libraries) (define (get-unix/macos-link-libraries)
(list (lambda () (case (string->symbol (path->string (system-library-subpath #f)))
(if (current-use-mzdyn) [(i386-cygwin)
(map (lambda (mz.o) (make-win-link-libraries #t #f #t)]
(path->string (build-path std-library-dir mz.o))) [else
((wrap-3m "mzdyn~a.o"))) (list (lambda ()
null)))) (if (current-use-mzdyn)
(map (lambda (mz.o)
(path->string (build-path std-library-dir mz.o)))
((wrap-3m "mzdyn~a.o")))
null)))]))
;; See doc.txt: ;; See doc.txt:
(define current-standard-link-libraries (define current-standard-link-libraries
(make-parameter (make-parameter
(case (system-type) (case (system-type)
[(unix macos macosx) (get-unix/macos-link-libraries)] [(unix macos macosx) (get-unix/macos-link-libraries)]
[(windows) (make-win-link-libraries win-gcc? win-borland?)]) [(windows) (make-win-link-libraries win-gcc? win-borland? #f)])
(lambda (l) (lambda (l)
(unless (and (list? l) (unless (and (list? l)
(andmap (lambda (s) (or (path-string? s) (andmap (lambda (s) (or (path-string? s)
@ -252,7 +267,7 @@
(current-extension-linker-flags win-gcc-linker-flags) (current-extension-linker-flags win-gcc-linker-flags)
(current-make-link-input-strings (lambda (s) (list (path-string->string s)))) (current-make-link-input-strings (lambda (s) (list (path-string->string s))))
(current-make-link-output-strings win-gcc-link-output-strings) (current-make-link-output-strings win-gcc-link-output-strings)
(current-standard-link-libraries (make-win-link-libraries #t #f)))] (current-standard-link-libraries (make-win-link-libraries #t #f #f)))]
[(borland) (let ([f (find-executable-path "ilink32.exe" #f)]) [(borland) (let ([f (find-executable-path "ilink32.exe" #f)])
(unless f (unless f
(error 'use-standard-linker "cannot find ilink32.exe")) (error 'use-standard-linker "cannot find ilink32.exe"))
@ -260,7 +275,7 @@
(current-extension-linker-flags borland-linker-flags) (current-extension-linker-flags borland-linker-flags)
(current-make-link-input-strings (lambda (s) (list (path-string->string s)))) (current-make-link-input-strings (lambda (s) (list (path-string->string s))))
(current-make-link-output-strings borland-link-output-strings) (current-make-link-output-strings borland-link-output-strings)
(current-standard-link-libraries (make-win-link-libraries #f #t)))] (current-standard-link-libraries (make-win-link-libraries #f #t #f)))]
[(msvc) (let ([f (find-executable-path "cl.exe" #f)]) [(msvc) (let ([f (find-executable-path "cl.exe" #f)])
(unless f (unless f
(error 'use-standard-linker "cannot find MSVC's cl.exe")) (error 'use-standard-linker "cannot find MSVC's cl.exe"))
@ -268,7 +283,7 @@
(current-extension-linker-flags msvc-linker-flags) (current-extension-linker-flags msvc-linker-flags)
(current-make-link-input-strings (lambda (s) (list (path-string->string s)))) (current-make-link-input-strings (lambda (s) (list (path-string->string s))))
(current-make-link-output-strings msvc-link-output-strings) (current-make-link-output-strings msvc-link-output-strings)
(current-standard-link-libraries (make-win-link-libraries #f #f)))] (current-standard-link-libraries (make-win-link-libraries #f #f #f)))]
[else (bad-name name)])] [else (bad-name name)])]
[(macos) [(macos)
(case name (case name
@ -314,7 +329,7 @@
(when (and dlltool basefile) (when (and dlltool basefile)
(let* ([dll-command (let* ([dll-command
;; Generate DLL link information ;; Generate DLL link information
`("--dllname" ,out `("--dllname" ,(if (path? out) (path->string out) out)
,@(if (current-use-mzdyn) ,@(if (current-use-mzdyn)
`("--def" ,(path->string (build-path std-library-dir "gcc" "mzdyn.def"))) `("--def" ,(path->string (build-path std-library-dir "gcc" "mzdyn.def")))
`()) `())
@ -323,16 +338,20 @@
;; Command to link with new .exp, re-create .base: ;; Command to link with new .exp, re-create .base:
[command1 [command1
(map (lambda (s) (map (lambda (s)
(if (regexp-match "[.]exp$" s) (let ([s (if (path? s)
(path->string expfile) (path->string s)
s)) s)])
(if (regexp-match "[.]exp$" s)
(path->string expfile)
s)))
command)] command)]
;; Command to link with new .exp file, no .base needed: ;; Command to link with new .exp file, no .base needed:
[command2 [command2
(let loop ([l command1]) (let loop ([l command1])
(cond (cond
[(null? l) null] [(null? l) null]
[(string=? (car l) "--base-file") [(and (string? (car l))
(string=? (car l) "--base-file"))
(cddr l)] (cddr l)]
[else (cons (car l) (loop (cdr l)))]))]) [else (cons (car l) (loop (cdr l)))]))])
(unless quiet? (unless quiet?

View File

@ -162,36 +162,42 @@
[(rs6k-aix) (list "-lc")] [(rs6k-aix) (list "-lc")]
[else null]) [else null])
(define (delete/continue x) (with-new-flags
(with-handlers ([(lambda (x) #t) void]) current-standard-link-libraries
(delete-file x))) (case mach-id
[(i386-cygwin) (list "-lc")]
[else null])
(make-directory* dir) (define (delete/continue x)
(with-handlers ([(lambda (x) #t) void])
(delete-file x)))
(last-chance-k (make-directory* dir)
(lambda ()
(make/proc
(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 (last-chance-k
(append (list file.c) (lambda ()
(filter (lambda (x) (make/proc
(regexp-match #rx#"mzdyn[a-z0-9]*[.]o" (list (list file.so
(if (string? x) (list file.o)
x (lambda ()
(path->string x)))) (link-extension #f (append (list file.o)
(expand-for-link-variant (current-standard-link-libraries))) (if is-win?
headers null
extra-depends) (map (lambda (l)
(lambda () (string-append "-l" (string-path->string l)))
(compile-extension #f file.c file.o ())))) (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 ()))))
#()))))))))))))

View File

@ -46,7 +46,14 @@
(make-directory* tmp-dir) (make-directory* tmp-dir)
(compile-c-extension-parts c-files tmp-dir) (compile-c-extension-parts c-files tmp-dir)
(parameterize ([current-directory tmp-dir]) (parameterize ([current-directory tmp-dir])
(link-extension #f (directory-list tmp-dir) so-name)) (link-extension #f (append
(directory-list tmp-dir)
(if (string=? "i386-cygwin"
(path->string (system-library-subpath #f)))
;; DLL needs every dependence explicit:
'("-lc" "-lm" "-lcygwin" "-lkernel32")
null))
so-name))
(delete-directory/files tmp-dir)))))) (delete-directory/files tmp-dir))))))
(provide pre-installer) (provide pre-installer)