[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] CLC post pathnames ...
From: |
Dennis Decker Jensen |
Subject: |
[Gcl-devel] CLC post pathnames ... |
Date: |
Thu, 29 Apr 2004 15:33:04 +0000 |
Hi Michael
I noticed you started looking at pathnames &c.
When I tried to get CLC working with GCL
I made the little Bourne shell script
necessary to get GCL working with CLC,
or at least a first shot at it.
In case you or others get around to play
around with CLC I put it out here free
to use. It might come in handy in case
you haven't made a script already.
--
gcl.sh
=====
#!/bin/sh
progname=$(basename $0)
gcl_clc=/usr/lib/common-lisp/gcl/common-lisp-controller
#if test ! -f $gcl_clc/common-lisp-controller.o; then
if test ! -f
/usr/share/common-lisp/source/common-lisp-controller/common-lisp-controller.lisp;
then
echo "Cannot find common-lisp-controller." 1>&2
echo "Please report this as a bug." 1>&2
exit 1
fi
gcl=$(command -v ${progname%.sh})
gcl_system_dir=$($gcl -batch -eval '(princ si:*system-directory*)')
image=$gcl_system_dir/saved_ansi_gcl
pristine_image=$gcl_system_dir/saved_ansi_gcl_pristine
new_image=$gcl_system_dir/saved_ansi_gcl_new
build_error()
{
echo "Error building $1" 1>&2
exit 1
}
image_error()
{
echo "Error moving new lisp image $new_image" 1>&2
exit 1
}
command=$1
shift
case $command in
rebuild)
echo $progname Rebuilding ...
while test -x $gcl -a -n "$1"
do
echo $progname rebuilding $1
$gcl -batch -eval "
(progn
(handler-case
(progn
(c-l-c:compile-library (quote $1))
(quit 0))
(error (err)
(ignore-errors (format t \"~&Build error: ~A~%\" err))
(finish-output)
(quit 1)))) " || build_error $1
shift
done
;;
remove)
echo $progname Removing ...
while test -n "$1"
echo $progname removing $1
do
rm -rf "$gcl_clc/$1"
shift
done
rmdir $gcl_clc 2> /dev/null
;;
install-clc)
echo $progname Installing clc ...
if test ! -f $pristine_image; then
mv -f $image $pristine_image
cp -f $pristine_image $image
fi
if test -x $gcl; then
$gcl -batch -eval "
(handler-case
(progn
;; A temporary condition until _after_ GCL version 2.6.2
(in-package :common-lisp)
(unless (fboundp 'load-time-value)
(defun load-time-value (obj) obj)
(export (find-symbol \"LOAD-TIME-VALUE\")))
(in-package :common-lisp-user)
(load
\"/usr/share/common-lisp/source/common-lisp-controller/common-lisp-controller.lisp\")
;;;; XXX This fails currently due to obsolete pathnames
;;;; XXX ANSI standard pathnames is needed to continue work.
;;;; XXX There may be potential problems with packages,
;;;; XXX but may just be a side-effect from pathname errors...
(in-package :common-lisp-controller)
(init-common-lisp-controller \"$gcl_clc\" :version 3)
(defun send-clc-command (command package)
\"Overrides global definition.\"
(multiple-value-bind (exit-code signal-code)
(si::system (c-l-c:make-clc-send-command-string
command package \"gcl\"))
(if (and (zerop exit-code) (zerop signal-code))
(values)
(error \"Error during ~A of ~A for ~A~%Please see
/usr/share/doc/common-lisp-controller/REPORTING-BUGS.gz\"
(ecase command
(:recompile \"recompilation\")
(:remove \"removal\"))
package
\"gcl\"))))
(si:save-system \"$new_image\")
(quit 0))
(error (err)
(ignore-errors (format t \"~&Install-clc error: ~A~%\" err))
(finish-output)
(quit 1)))" || build_error send-clc-command
mv -f $new_image $image || image_error
fi
;;
remove-clc)
echo $progname Uninstalling clc and restoring pristine (orig) image ...
if test -f $pristine_image; then
cp -f $pristine_image $image
else
echo "Cannot find pristine image file $pristine_image." 1>&2
fi
;;
make-user-image)
echo $progname Building image with $1 ...
if test ! -r $1; then
echo "Trying to make user image: Cannot access file $1" 1>&2
exit 1
fi
$gcl -batch -eval "
(progn
(load \"$1\")
(si:save-system \"$new_image\")
(quit 0))" || build_error $1
mv -f $new_image $image || image_error
;;
*)
expr $command : '.*\(help\).*' > /dev/null 2>&1 || \
echo "$progname: Unknown command '$command'" 1>&2
echo "Usage: $progname <command>" 1>&2
echo "Where <command> is one of:" 1>&2
echo " install-clc, remove-clc," 1>&2
echo " rebuild <package>*, remove <package>*," 1>&2
echo " or make-user-image <load-file>" 1>&2
echo "And <package> is a cl-debpkg (e.g. cl-rt)" 1>&2
echo " with a defsystem/asdf definition." 1>&2
exit 1
;;
esac
exit 0
=====
Put it in /usr/lib/common-lisp/bin/
and you are ready to go ...
Dennis Decker Jensen
"Organizations which design systems are constrained to produce
designs which are copies of the communication structures of these
organizations."
-- Melvin Conway, 1968
"Conway's Law: The structure of a system reflects the structure
of the organization that built it.
Conway's Law has been stated even more strongly:
The structure of any system designed by an organization
is isomorphic to the structure of the organization."
-- Edward Yourdon and Larry L. Constantine, 1979
- [Gcl-devel] CLC post pathnames ...,
Dennis Decker Jensen <=