From a4263d6d79a33293ea5ec264af1b076a098fc89a Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Fri, 15 Jun 2007 12:28:55 +0000 Subject: [PATCH] Applied Win32 patch/code cleanups Organization: Straylight/Edgeware From: espen --- tools/asdf-extensions.lisp | 74 ++++++++++--------- tools/config.lisp | 141 +++++++++++++++++++++++-------------- 2 files changed, 128 insertions(+), 87 deletions(-) diff --git a/tools/asdf-extensions.lisp b/tools/asdf-extensions.lisp index 576c8f8..f533a64 100644 --- a/tools/asdf-extensions.lisp +++ b/tools/asdf-extensions.lisp @@ -2,7 +2,8 @@ (in-package :asdf) (export '*dso-extension*) -(defparameter *dso-extension* #-darwin"so" #+darwin"dylib") +(defparameter *dso-extension* + #-(and darwin win32)"so" #+darwin"dylib" #+win32"dll") ;;; The following code is more or less copied frm sb-bsd-sockets.asd, @@ -28,24 +29,26 @@ (defmethod output-files ((operation compile-op) (dso unix-dso)) :directory (butlast (pathname-directory dir)) :defaults dir)))) - (defmethod perform :after ((operation compile-op) (dso unix-dso)) - (let ((dso-name (unix-name (car (output-files operation dso))))) + (let ((output (first (output-files operation dso))) + (inputs (mapcar #'unix-name + (mapcan #'(lambda (c) + (output-files operation c)) + (module-components dso))))) (unless (zerop - (run-shell-command - "gcc ~A -o ~S ~{~S ~}" - (clg-utils:concatenate-strings - (cons - #+sunos "-shared -lresolv -lsocket -lnsl" - #+darwin "-bundle" - #-(or darwin sunos) "-shared" - (slot-value dso 'ldflags)) - #\sp) - dso-name - (mapcar #'unix-name - (mapcan (lambda (c) - (output-files operation c)) - (module-components dso))))) + (run-shell-command "gcc ~A~{ ~A~} -o ~S~{ ~S~}" + #-(and darwin win32)"-shared" + #+darwin "-bundle" + #+win32 + (format nil "-shared -Wl,--out-implib,~S" + (unix-name + (make-pathname + :type "a" + :name (format nil "lib~Adll" (pathname-name output)) + :defaults output))) + (slot-value dso 'ldflags) + (unix-name output) + inputs)) (error 'operation-error :operation operation :component dso)))) #+clisp @@ -80,21 +83,20 @@ (defmethod output-files ((op compile-op) (c c-source-file)) (defmethod perform ((op compile-op) (c c-source-file)) (unless - (= 0 (run-shell-command "gcc ~A -o ~S -c ~S" - (clg-utils:concatenate-strings - (append - (list "-fPIC") - (when (slot-value c 'optimization) - (list (format nil "-O~A" (slot-value c 'optimization)))) - (loop - for symbol in (slot-value c 'definitions) - collect (format nil "-D~A" symbol)) - (loop - for path in (slot-value c 'include-paths) - collect (format nil "-I~A" path)) - (slot-value c 'cflags)) - #\sp) - (unix-name (car (output-files op c))) + (= 0 (run-shell-command "gcc ~A~{ ~A~} -o ~S -c ~S" + #-win32 "-fPIC" + #+win32 "-DBUILD_DLL" + (nconc + (when (slot-value c 'optimization) + (list (format nil "-O~A" (slot-value c 'optimization)))) + (loop + for symbol in (slot-value c 'definitions) + collect (format nil "-D~A" symbol)) + (loop + for path in (slot-value c 'include-paths) + collect (format nil "-I~A" path)) + (slot-value c 'cflags)) + (unix-name (first (output-files op c))) (unix-name (component-pathname c)))) (error 'operation-error :operation op :component c))) @@ -127,8 +129,14 @@ (defmethod component-pathname ((lib library)) :name (or (slot-value lib 'libname) (component-name lib)) :directory (split-path (slot-value lib 'libdir)))) +;; --fix: is UNIX-NAME really necessary for win32? i know it will bomb +;; without using it while doing (ASDF:OOS 'ASDF:LOAD-OP :GLIB) but +;; loading the complete pathname for libglib-2.0-0.dll with +;; SB-ALIEN:LOAD-SHARED-OBJECT by hand won't explode. weird. +;; - cph 18-May-2007 (defmethod perform ((o load-op) (c library)) - (load-dso (component-pathname c))) + (load-dso #-win32 (component-pathname c) + #+win32 (unix-name (component-pathname c)))) (defmethod perform ((operation operation) (c library)) nil) diff --git a/tools/config.lisp b/tools/config.lisp index aa15f19..4d30a4c 100644 --- a/tools/config.lisp +++ b/tools/config.lisp @@ -2,50 +2,35 @@ (defpackage #:pkg-config (:use #:common-lisp #:clg-utils #+(or cmu clisp) #:ext #+sbcl #:sb-ext) #+sbcl (:import-from #:sb-int #:featurep) - (:export #:pkg-cflags #:pkg-libs #:pkg-exists-p #:pkg-version #:pkg-variable) - (:export #:featurep #:sbcl>= #:clisp>=)) + (:export #:pkg-cflags #:pkg-libs #:pkg-exists-p #:pkg-version + #:pkg-variable #:pkg-libdir #:tmpname) + (:export #:featurep #:sbcl>= #:sbcl< #:clisp>=)) (in-package #:pkg-config) -(defparameter *pkg-config* "/usr/bin/pkg-config") +(defparameter *pkg-config* "pkg-config") -#+(or sbcl cmu) -(defun run-pkg-config (package error-p &rest options) - (let ((process - (run-program - *pkg-config* (cons package options) :wait t :output :stream))) - (unless process - (error "Unable to run ~A" *pkg-config*)) - (let ((exit-code (process-exit-code process))) - (unless (or (not error-p) (zerop exit-code)) - (error - (or - (format nil "~A: ~{~A~%~}" *pkg-config* (read-lines (process-error process))) - (format nil "~A terminated with exit code ~A" - *pkg-config* exit-code)))) - (let ((output (read-lines (process-output process)))) - (process-close process) - (values output exit-code))))) +(defun tmpname (suffix) + (format nil "~Aclg-~A-~A" + #-win32 "/tmp/" #+win32 "c:/temp/" + #+sbcl(sb-posix:getpid) + #+cmu(unix:unix-getpid) + #+clisp(os:process-id) + suffix)) -#+clisp (defun run-pkg-config (package error-p &rest options) - (let ((outfile (format nil "/tmp/clg-pkg-config-~A-output" (os:process-id))) - (errfile (format nil "/tmp/clg-pkg-config-~A-error" (os:process-id)))) + (let ((outname (tmpname "pkg-config"))) (unwind-protect - (let ((exit-code - (run-shell-command - (format nil "~A ~A ~{~A ~}2>~A" - *pkg-config* package - (mapcar #'(lambda (option) - (format nil "'~A'" option)) - options) - errfile) - :output outfile :if-output-exists :overwrite))) + (let* ((asdf::*verbose-out* nil) + (exit-code + (asdf:run-shell-command + "~A ~A ~:[~;--print-errors ~]~{~A ~} &>~A" + *pkg-config* package error-p options outname))) (cond ((= exit-code 127) (error "Unable to run ~A" *pkg-config*)) ((and error-p (not (zerop exit-code))) - (with-open-file (output errfile) + (with-open-file (output outname) (let ((errmsg (read-lines output))) (error (if (not errmsg) @@ -53,12 +38,10 @@ (defun run-pkg-config (package error-p &rest options) (format nil "~A: ~{~A~%~}" *pkg-config* errmsg)))))) (t (values - (with-open-file (output outfile) + (with-open-file (output outname) (read-lines output)) exit-code)))) - (progn - (delete-file outfile) - (delete-file errfile))))) + (delete-file outname)))) (defun pkg-cflags (package) @@ -68,30 +51,74 @@ (defun pkg-libs (package) (split-string (first (run-pkg-config package t "--libs")))) +;; With +;; (let ((version-check +;; (cond +;; (version (format nil "= ~A" version)) +;; (atleast-version (format nil ">= ~A" atleast-version)) +;; (max-version (format nil "<= ~A" max-version)) +;; (t "")))) +;; ...) +;; when running +;; (PKG-EXISTS-P "glib-2.0" :ATLEAST-VERSION "2.4.0" :ERROR T) +;; the EXIT-CODE in RUN-PKG-CONFIG will be 1 on ms windows and 0 on linux + +;; Both on ms windows and linux +;; "pkg-config glib-2.0 --print-errors -exists >=2.4.0" is O.K. but +;; "pkg-config glib-2.0 --print-errors -exists >= 2.4.0" prints out +;; an error message. +;; However, +;; "pkg-config glib-2.0 --print-errors -exists =2.12.11" prints out +;; an error message but +;; "pkg-config glib-2.0 --print-errors -exists = 2.12.11" is O.K. +;; We can get around this problem by using +;; (let ((version-check +;; (cond +;; (version (format nil "--exact-version=~A" version)) +;; (atleast-version (format nil "--atleast-version=~A" atleast-version)) +;; (max-version (format nil "--max-version=~A" max-version)) +;; (t "")))) +;; ...) +;; - cph 17-May-2007 + +;; Could the problem with --exists on win32 be caused by improper quoting? +;; Since --exact-version, --atleast-version and --max-version doesn't print +;; any error message, we stick to --exists on non Win32 platforms. +;; - esj 2007-06-14 + + +;; --fix: in win32 sbcl +;; (pkg-exists-p "glib-2.0" :version "3.12.11" :error t) +;; will hang indefinitely. - cph 17-May-2007 + (defun pkg-exists-p (package &key version atleast-version max-version error) (let ((version-check (cond - (version (format nil "= ~A" version)) - (atleast-version (format nil ">= ~A" atleast-version)) - (max-version (format nil "<= ~A" max-version)) + (version + #-win32(format nil "--exists \"= ~A\"" version) + #+win32(format nil "--exact-version=~A" version)) + (atleast-version + #-win32(format nil "--exists \">= ~A\"" atleast-version) + #+win32(format nil "--atleast-version=~A" atleast-version)) + (max-version + #-win32(format nil "--exists \"<= ~A\"" max-version) + #+win32(format nil "--max-version=~A" max-version)) (t "")))) - (if error - (progn - (run-pkg-config package t "--print-errors" "--exists" version-check) - t) - (multiple-value-bind (output exit-code) - (run-pkg-config package nil "--exists" version-check) - (declare (ignore output)) - (zerop exit-code))))) - + (zerop (nth-value 1 (run-pkg-config package error version-check))))) (defun pkg-version (package) (first (run-pkg-config package t "--modversion"))) - (defun pkg-variable (package variable) (first (run-pkg-config package t "--variable" variable))) +(defun pkg-libdir (package) + #-win32 + (pkg-variable package "libdir") + #+win32 + (let ((ldir (pkg-variable package "libdir"))) + (format nil "~Abin" (subseq ldir 0 (search "lib" ldir :from-end t))))) + (defun |#?-reader| (stream subchar arg) (declare (ignore subchar arg)) @@ -130,12 +157,18 @@ (defun sbcl>= (req-major req-minor req-micro) (or (> major req-major) (and (= major req-major) (> minor req-minor)) - (and (= major req-major) (= minor req-minor) (>= micro req-micro)))))) + (and (= major req-major) (= minor req-minor) (>= micro req-micro))))) + (defun sbcl< (req-major req-minor req-micro) + (not (sbcl>= req-major req-minor req-micro)))) #-sbcl -(defun sbcl>= (req-major req-minor req-micro) - (declare (ignore req-major req-minor req-micro)) - nil) +(progn + (defun sbcl>= (req-major req-minor req-micro) + (declare (ignore req-major req-minor req-micro)) + nil) + (defun sbcl< (req-major req-minor req-micro) + (declare (ignore req-major req-minor req-micro)) + nil)) #+clisp (progn -- [mdw]