diff --git a/.cvsignore b/.cvsignore index ef3a9ef6f..ea0751093 100644 --- a/.cvsignore +++ b/.cvsignore @@ -5,3 +5,4 @@ customize-backend-subfeatures.lisp customize-target-features.lisp local-target-features.lisp-expr TAGS +.svn diff --git a/COPYING b/COPYING index 2bdd04d1a..5fc177975 100644 --- a/COPYING +++ b/COPYING @@ -1,3 +1,6 @@ +Steel Bank Common Lisp (SBCL) is free software, and comes with +absolutely no warranty. + SBCL is derived from CMU CL, which was released into the public domain, subject only to the BSD-style "free, but credit must be given and copyright notices must be retained" licenses in the LOOP macro diff --git a/install.sh b/install.sh index c00a6f441..4710e8210 100644 --- a/install.sh +++ b/install.sh @@ -25,7 +25,6 @@ INFO_DIR=${INFO_DIR-$INSTALL_ROOT/share/info} DOC_DIR=${DOC_DIR-$INSTALL_ROOT/share/doc/sbcl} # Does the environment look sane? -SBCL_SOURCE=`pwd` if [ -n "$SBCL_HOME" -a "$INSTALL_ROOT/lib/sbcl" != "$SBCL_HOME" ];then echo SBCL_HOME environment variable is set, and conflicts with INSTALL_ROOT. echo Aborting installation. Unset one or reset the other, then try again @@ -70,7 +69,10 @@ cp output/sbcl.core $BUILD_ROOT$SBCL_HOME/sbcl.core # installing contrib -SBCL="`pwd`/src/runtime/sbcl --noinform --core `pwd`/output/sbcl.core --no-userinit --no-sysinit --disable-debugger" +. ./sbcl-pwd.sh +sbcl_pwd + +SBCL="$SBCL_PWD/src/runtime/sbcl --noinform --core $SBCL_PWD/output/sbcl.core --no-userinit --no-sysinit --disable-debugger" SBCL_BUILDING_CONTRIB=1 export SBCL SBCL_BUILDING_CONTRIB diff --git a/make-target-contrib.sh b/make-target-contrib.sh index 6d10ca3d3..78d6574fa 100644 --- a/make-target-contrib.sh +++ b/make-target-contrib.sh @@ -21,20 +21,13 @@ export LANG LC_ALL . ./find-gnumake.sh find_gnumake -# usually SBCL_HOME refers to the installed root of SBCL, not the -# build directory. Right now, however, where there are dependencies -# between contrib packages, we want the _uninstalled_ versions to be -# found -if [ "$OSTYPE" = "cygwin" ] ; then - SBCL_BASE=`cygpath -m $(pwd)` -else - SBCL_BASE=`pwd` -fi -SBCL_HOME=$SBCL_BASE/contrib +. ./sbcl-pwd.sh +sbcl_pwd + +SBCL_HOME=$SBCL_PWD/contrib export SBCL_HOME - -SBCL="$SBCL_BASE/src/runtime/sbcl --noinform --core $SBCL_BASE/output/sbcl.core --disable-debugger --no-sysinit --no-userinit" +SBCL="$SBCL_PWD/src/runtime/sbcl --noinform --core $SBCL_PWD/output/sbcl.core --disable-debugger --no-sysinit --no-userinit" SBCL_BUILDING_CONTRIB=1 export SBCL SBCL_BUILDING_CONTRIB diff --git a/make-windows-installer.sh b/make-windows-installer.sh new file mode 100644 index 000000000..ccfa5f00d --- /dev/null +++ b/make-windows-installer.sh @@ -0,0 +1,31 @@ +#!/bin/sh + +# This software is part of the SBCL system. See the README file for +# more information. +# +# This software is derived from the CMU CL system, which was +# written at Carnegie Mellon University and released into the +# public domain. The software is in the public domain and is +# provided with absolutely no warranty. See the COPYING and CREDITS +# files for more information. + +WIX_PATH="${WIX_PATH:-$PROGRAMFILES\WiX}" + +. ./sbcl-pwd.sh +sbcl_pwd + +cd output + +"$SBCL_PWD/src/runtime/sbcl" --noinform --core "$SBCL_PWD/output/sbcl.core" \ + --disable-debugger --no-sysinit --no-userinit \ + --load ../tools-for-build/rtf.lisp \ + --load ../tools-for-build/wxs.lisp \ + --eval '(progn + (write-rtf (read-text "../COPYING") "License.rtf") + (write-wxs "sbcl.wxs") + (quit))' + +"$WIX_PATH/candle" sbcl.wxs +"$WIX_PATH/light" sbcl.wixobj "$WIX_PATH/wixui.wixlib" \ + -loc "$WIX_PATH/WixUI_en-us.wxl" \ + -out sbcl.msi diff --git a/sbcl-pwd.sh b/sbcl-pwd.sh new file mode 100644 index 000000000..e4be84d71 --- /dev/null +++ b/sbcl-pwd.sh @@ -0,0 +1,13 @@ +#!/bin/false +# Not a shell script, but something intended to be sourced from shell scripts + +# This ensures that SBCL_PWD is a path understandable to SBCL. + +sbcl_pwd() { + if [ "$OSTYPE" = "cygwin" ] ; then + SBCL_PWD=`cygpath -m $a(pwd)` + else + SBCL_PWD=`pwd` + fi + export SBCL_PWD +} diff --git a/tests/run-tests.sh b/tests/run-tests.sh index eb8f00bba..debc22ab2 100644 --- a/tests/run-tests.sh +++ b/tests/run-tests.sh @@ -26,10 +26,14 @@ # pathname, but now we take care to bind it to an absolute pathname (still # generated relative to `pwd` in the tests/ directory) so that tests # can chdir before invoking SBCL and still work. -SBCL_HOME=`pwd`/../contrib +. ../sbcl-pwd.sh +sbcl_pwd + +SBCL_HOME=$SBCL_PWD/../contrib export SBCL_HOME -sbclstem=`pwd`/../src/runtime/sbcl -SBCL="$sbclstem --core `pwd`/../output/sbcl.core --noinform --sysinit /dev/null --userinit /dev/null --noprint --disable-debugger" +sbclstem=$SBCL_PWD/../src/runtime/sbcl + +SBCL="$sbclstem --core $SBCL_PWD/../output/sbcl.core --noinform --sysinit /dev/null --userinit /dev/null --noprint --disable-debugger" export SBCL echo /running tests on SBCL=\'$SBCL\' # more or less like SBCL, but without enough grot removed that appending diff --git a/tools-for-build/rtf.lisp b/tools-for-build/rtf.lisp new file mode 100644 index 000000000..d63805c4b --- /dev/null +++ b/tools-for-build/rtf.lisp @@ -0,0 +1,44 @@ +;;;; Generate RTF out of a regular text file, splitting +;;;; paragraphs on empty lines. +;;;; +;;;; Used to generate License.rtf out of COPYING for the +;;;; Windows installer. + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(defun read-text (pathname) + (let ((pars (list nil))) + (with-open-file (f pathname :external-format :ascii) + (loop for line = (read-line f nil) + for text = (string-trim '(#\Space #\Tab) line) + while line + when (plusp (length text)) + do (setf (car pars) + (if (car pars) + (concatenate 'string (car pars) " " text) + text)) + else + do (push nil pars))) + (nreverse pars))) + +(defun write-rtf (pars pathname) + (with-open-file (f pathname :direction :output :external-format :ascii + :if-exists :supersede) + ;; \rtf0 = RTF 1.0 + ;; \ansi = character set + ;; \deffn = default font + ;; \fonttbl = font table + ;; \fs = font size in half-points + (format f "{\\rtf1\\ansi~ + \\deffn0~ + {\\fonttbl\\f0\\fswiss Helvetica;}~ + \\fs20~ + ~{~A\\par\\par~%~}}~%" + pars))) diff --git a/tools-for-build/wxs.lisp b/tools-for-build/wxs.lisp new file mode 100644 index 000000000..b6d4faa05 --- /dev/null +++ b/tools-for-build/wxs.lisp @@ -0,0 +1,246 @@ +;;;; Generate WiX XML Source, from which we eventually generate the .MSI + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +;;;; XML generation + +(defvar *indent-level* 0) + +(defun print-xml (sexp &optional (stream *standard-output*)) + (destructuring-bind (tag &optional attributes &body children) sexp + (when attributes (assert (evenp (length attributes)))) + (format stream "~VT<~A~{ ~A='~A'~}~@[/~]>~%" + *indent-level* tag attributes (not children)) + (let ((*indent-level* (+ *indent-level* 3))) + (dolist (child children) + (unless (listp child) + (error "Malformed child: ~S in ~S" child children)) + (print-xml child stream))) + (when children + (format stream "~VT~%" *indent-level* tag)))) + +(defun xml-1.0 (pathname sexp) + (with-open-file (xml pathname :direction :output :if-exists :supersede + :external-format :ascii) + (format xml "") + (print-xml sexp xml))) + +(defun application-name () + (format nil "SBCL ~A" (lisp-implementation-version))) + +;;;; GUID generation +;;;; +;;;; Apparently this willy-nilly regeneration of GUIDs is a bad thing, and +;;;; we should probably have a single GUID per release / Component, so +;;;; that no matter by whom the .MSI is built the GUIDs are the same. +;;;; +;;;; Something to twiddle on a rainy day, I think. + +(load-shared-object "OLE32.DLL") + +(define-alien-type uuid + (struct uuid + (data1 unsigned-long) + (data2 unsigned-short) + (data3 unsigned-short) + (data4 (array unsigned-char 8)))) + +(define-alien-routine ("CoCreateGuid" co-create-guid) int (guid (* uuid))) + +(defun uuid-string (uuid) + (declare (type (alien (* uuid)) uuid)) + (let ((data4 (slot uuid 'data4))) + (format nil "~8,'0X-~4,'0X-~4,'0X-~2,'0X~2,'0X-~{~2,'0X~}" + (slot uuid 'data1) + (slot uuid 'data2) + (slot uuid 'data3) + (deref data4 0) + (deref data4 1) + (loop for i from 2 upto 7 collect (deref data4 i))))) + +(defun make-guid () + (let (guid) + (unwind-protect + (progn + (setf guid (make-alien (struct uuid))) + (co-create-guid guid) + (uuid-string guid)) + (free-alien guid)))) + +(defun list-all-contribs () + (loop for flag in (directory "../contrib/*/test-passed") + collect (car (last (pathname-directory flag))))) + +(defun id (string) + ;; Mangle a string till it can be used as an Id. A-Z, a-z, 0-9, and + ;; _ are ok, nothing else is. + (nsubstitute #\_ #\- + (nsubstitute #\. #\: + (nsubstitute #\. #\/ + (substitute #\. #\\ string))))) + +(defun directory-id (name) + (id (format nil "Directory_~A" (enough-namestring name)))) + +(defun directory-names (pathname) + (let ((name (car (last (pathname-directory pathname))))) + (if (< 8 (length name)) + (list "Name" (subseq name 0 8) + "LongName" name) + (list "Name" name)))) + +(defun file-id (pathname) + (id (format nil "File_~A" (enough-namestring pathname)))) + +(defparameter *ignored-directories* '("CVS" ".svn")) + +(defparameter *pathname-type-abbrevs* + '(("lisp" . "lsp") + ("fasl" . "fas") + ("SBCL" . "txt") ; README.SBCL -> README.txt + ("texinfo" . "tfo") + ("lisp-temp" . "lmp"))) + +(defun file-names (pathname) + (if (or (< 8 (length (pathname-name pathname))) + (< 3 (length (pathname-type pathname)))) + (let ((short-name (let ((name (pathname-name pathname))) + (if (< 8 (length name)) + (subseq name 0 8) + name))) + (short-type (let ((type (pathname-type pathname))) + (if (< 3 (length type)) + (or (cdr (assoc type *pathname-type-abbrevs* :test #'equalp)) + (error "No abbreviation for type: ~A" type)) + type)))) + (list "Name" (if short-type + (format nil "~A.~A" short-name short-type) + short-name) + "LongName" (file-namestring pathname))) + (list "Name" (file-namestring pathname)))) + +(defparameter *components* nil) + +(defun component-id (pathname) + (let ((id (id (format nil "Contrib_~A" (enough-namestring pathname))))) + (push id *components*) + id)) + +(defun ref-all-components () + (prog1 + (mapcar (lambda (id) + `("ComponentRef" ("Id" ,id))) + *components*) + (setf *components* nil))) + +(defun collect-1-component (root) + `("Directory" ("Id" ,(directory-id root) + ,@(directory-names root)) + ("Component" ("Id" ,(component-id root) + "Guid" ,(make-guid) + "DiskId" 1) + ,@(loop for file in (directory + (make-pathname :name :wild :type :wild :defaults root)) + when (or (pathname-name file) (pathname-type file)) + collect `("File" ("Id" ,(file-id file) + ,@(file-names file) + "Source" ,(enough-namestring file))))))) + +(defun collect-components (root) + (cons (collect-1-component root) + (loop for directory in + (directory + (merge-pathnames (make-pathname + :directory '(:relative :wild) + :name nil :type nil) + root)) + unless (member (car (last (pathname-directory directory))) + *ignored-directories* :test #'equal) + append (collect-components directory)))) + +(defun collect-contrib-components () + (loop for contrib in (directory "../contrib/*/test-passed") + append (collect-components (make-pathname :name nil + :type nil + :version nil + :defaults contrib)))) + +(defun make-extension (type mime) + `("Extension" ("Id" ,type "ContentType" ,mime) + ("Verb" ("Id" ,(format nil "load_~A" type) + "Argument" "--core \"[#sbcl.core]\" --load \"%1\"" + "Command" "Load with SBCL" + "Target" "[#sbcl.exe]")))) + +(defun write-wxs (pathname) + ;; both :INVERT and :PRESERVE could be used here, but this seemed + ;; better at the time + (xml-1.0 + pathname + `("Wix" ("xmlns" "http://schemas.microsoft.com/wix/2003/01/wi") + ("Product" ("Id" "????????-????-????-????-????????????" + "Name" ,(application-name) + "Version" ,(lisp-implementation-version) + "Manufacturer" "http://www.sbcl.org" + "Language" 1033) + ("Package" ("Id" "????????-????-????-????-????????????" + "Manufacturer" "http://www.sbcl.org" + "InstallerVersion" 200 + "Compressed" "yes")) + ("Media" ("Id" 1 + "Cabinet" "sbcl.cab" + "EmbedCab" "yes")) + ("Directory" ("Id" "TARGETDIR" + "Name" "SourceDir") + ("Directory" ("Id" "ProgramMenuFolder" + "Name" "PMFolder")) + ("Directory" ("Id" "ProgramFilesFolder" + "Name" "PFiles") + ("Directory" ("Id" "BaseFolder" + "Name" "SBCL" + "LongName" "Steel Bank Common Lisp") + ("Directory" ("Id" "VersionFolder" + "Name" ,(lisp-implementation-version)) + ("Directory" ("Id" "INSTALLDIR") + ("Component" ("Id" "SBCL_Base" + "Guid" ,(make-guid) + "DiskId" 1) + ("Environment" ("Id" "Env_SBCL_HOME" + "Action" "set" + "Name" "SBCL_HOME" + "Part" "all" + "Value" "[INSTALLDIR]")) + ("Environment" ("Id" "Env_PATH" + "Action" "set" + "Name" "PATH" + "Part" "first" + "Value" "[INSTALLDIR]")) + ,(make-extension "fasl" "application/x-lisp-fasl") + ,(make-extension "lisp" "text/x-lisp-source") + ("File" ("Id" "sbcl.exe" + "Name" "sbcl.exe" + "Source" "../src/runtime/sbcl.exe") + ("Shortcut" ("Id" "sbcl.lnk" + "Directory" "ProgramMenuFolder" + "Name" "SBCL" + "LongName" ,(application-name) + "Arguments" "--core \"[#sbcl.core]\""))) + ("File" ("Id" "sbcl.core" + "Name" "sbcl.cre" + "LongName" "sbcl.core" + "Source" "sbcl.core"))) + ,@(collect-contrib-components)))))) + ("Feature" ("Id" "Minimal" + "ConfigurableDirectory" "INSTALLDIR" + "Level" 1) + ("ComponentRef" ("Id" "SBCL_Base")) + ,@(ref-all-components)) + ("Property" ("Id" "WIXUI_INSTALLDIR" "Value" "INSTALLDIR")) + ("UIRef" ("Id" "WixUI_InstallDir")))))) diff --git a/version.lisp-expr b/version.lisp-expr index 084c954b1..d9540886e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.13.15" +"0.9.13.16"