common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

0.9.13.16: preliminary Windows installer builder

Browse source 
* Added "free software & no warranty" summary to top of COPYING.

 * tools-for-build/rtf.lisp turns COPYING into License.rtf needed
   for the installer.

 * tools-for-build/wxs.lisp generates the XML from which
   the installer is built.

 * refactor good-for-lisp pathname logic from make-target-contrib.sh
   to sbcl-pwd.sh.

 * make-windows-installer.sh builds sbcl.msi into output/,
   assuming WiX (2.0) is installed in $PROGRAMFILES/WiX or
   $WIX_PATH.

   The installer installs sbcl.exe, sbcl.core, and contribs
   into $PROGRAMFILES/Steel Bank Common Lisp/<sbcl-version>/
   by default, though the location is configurable.

   .lisp and .fasl files are associated with the installed
   SBCL, action being to start SBCL and load the file.

   The installation directory is added to PATH.

   SBCL_HOME is set to the installation directory.

   A shortcut is added to the start-menu. The shortcut refers
   to the core explicitly, and will continue to work even if
   a newer SBCL is installed.
This commit is contained in:
Nikodemus Siivola 2006-06-01 09:14:25 +00:00
parent 57f8e261b6
commit 1acfa21e07
10 changed files with 355 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.cvsignore
View file

@ -5,3 +5,4 @@ customize-backend-subfeatures.lisp
customize-target-features.lisp
local-target-features.lisp-expr
TAGS
.svn

3
COPYING
View file

@ -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

6
install.sh
View file

@ -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

17
make-target-contrib.sh
View file

@ -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

31
make-windows-installer.sh Normal file
View file

@ -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

13
sbcl-pwd.sh Normal file
View file

@ -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
}

10
tests/run-tests.sh
View file

@ -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

44
tools-for-build/rtf.lisp Normal file
View file

@ -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)))

246
tools-for-build/wxs.lisp Normal file
View file

@ -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</~A>~%" *indent-level* tag))))
(defun xml-1.0 (pathname sexp)
(with-open-file (xml pathname :direction :output :if-exists :supersede
:external-format :ascii)
(format xml "<?xml version='1.0'?>")
(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"))))))

2
version.lisp-expr
View file

@ -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"