#!/bin/sh #| cl-launch.sh -- shell wrapper generator for Common Lisp software -*- Lisp -*- CL_LAUNCH_VERSION='2.16' license_information () { AUTHOR_NOTE="\ # Please send your improvements to the author: # fare at tunes dot org < http://www.cliki.net/Fare%20Rideau >. " SHORT_LICENSE="\ # CL-Launch is available under the terms of the bugroff license. # http://www.geocities.com/SoHo/Cafe/5947/bugroff.html # You may at your leisure use the LLGPL instead < http://www.cliki.net/LLGPL > " WEB_SITE="# For the latest version of CL-Launch, see its web page at: # http://www.cliki.net/cl-launch " LICENSE_COMMENT="\ # This software can be used in conjunction with any other software: # the result may consist in pieces of the two software glued together in # a same file, but even then these pieces remain well distinguished, and are # each available under its own copyright and licensing terms, as applicable. # The parts that come from the other software are subject to the terms of use # and distribution relative to said software, which may well be # more restrictive than the terms of this software (according to lawyers # and the armed henchmen they got the taxpayers to pay to enforce their laws). # The bits of code generated by cl-launch, however, remain available # under the terms of their own license, and you may service them as you wish: # manually, using cl-launch --update or whichever means you prefer. # That said, if you believe in any of that intellectual property scam, # you may be subject to the terms of my End-Seller License: # http://www.livejournal.com/users/fare/21806.html " DISCLAIMER="\ # This file was automatically generated and contains parts of CL-Launch " } license_information ### Settings for the current installation -- adjust to your convenience ### Or see documentation for using commands -B install and -B install_bin. DEFAULT_LISPS="sbcl clisp ccl cmucl ecl gclcvs allegro lispworks lisp gcl" DEFAULT_INCLUDE_PATH= DEFAULT_USE_CL_LAUNCHRC= DEFAULT_USE_CLBUILD= ### Initialize cl-launch variables unset \ SOFTWARE_FILE SOFTWARE_SYSTEM SOFTWARE_INIT_FORMS \ SYSTEMS_PATHS INCLUDE_PATH LISPS WRAPPER_CODE \ OUTPUT_FILE UPDATE \ LINE LINE1 LINE2 NO_QUIT CONTENT_FILE \ TRIED_CONFIGURATION HAS_CONFIGURATION \ EXEC_LISP DO_LISP DUMP LOAD_IMAGE RESTART IMAGE IMAGE_OPT \ EXTRA_CONFIG_VARIABLES \ EXECUTABLE_IMAGE STANDALONE_EXECUTABLE CL_LAUNCH_STANDALONE \ TEST_SHELLS TORIG IMPL LISPS="$DEFAULT_LISPS" INCLUDE_PATH="$DEFAULT_INCLUDE_PATH" USE_CL_LAUNCHRC="$DEFAULT_USE_CL_LAUNCHRC" USE_CLBUILD="$DEFAULT_USE_CLBUILD" UNREAD_DEPTH=0 OUTPUT_FILE="!" ### Other constants MAGIC_MD5SUM="65bcc57c2179aad145614ec328ce5ba8" CONTENT_DISCLAIMER="\ ;;; THE SOFTWARE AFTER THIS MARKER AND TO THE END OF THE FILE IS NOT PART OF ;;; CL-LAUNCH BUT A PIECE OF SOFTWARE DISTINCT FROM CL-LAUNCH. IT IS OWNED BY ;;; BY ITS OWNERS AND IS SUBJECT ITS OWN INDEPENDENT TERMS OF AVAILABILITY." CONTENT_BEGIN_MARKER="\ ;;; ${MAGIC_MD5SUM} SOFTWARE WRAPPED BY CL-LAUNCH BEGINS HERE:" ### Help ## setup a few environment variables for the program BASIC_ENV_CODE='PROG="$0"' eval "$BASIC_ENV_CODE" PROGBASE="${0##*/}" # "$(basename "$0")" CL_LAUNCH_URL="http://fare.tunes.org/files/cl-launch/cl-launch.sh" HELP_HEADER="cl-launch.sh $CL_LAUNCH_VERSION -- shell wrapper generator for Common Lisp software" print_help_header () { ECHO "$HELP_HEADER" } print_help () { cat < ~/src/cl-launch/launcher.lisp Alternatively, you may include cl-launch itself instead of an extracted header, if only you tell your Lisp reader consider #! as introducing a line comment: (set-dispatch-macro-character #\\# #\\! #'(lambda (stream char arg) (declare (ignore char arg)) (values (read-line stream)))) #-cl-launch (load "/path/to/cl-launch.sh") Finally, if you use cl-launch from debian, or it was otherwise installed with cl-launch -B install or if you create the asd in addition to the header and declare it to asdf cl-launch -B print_cl_launch_asd > ~/src/cl-launch/cl-launch.asd then if your installed cl-launch.asd is properly symlinked from a directory in your asdf:*central-registry*, you may just have your software depend on the system :cl-launch (asdf:oos 'asdf:load-op :cl-launch) which in some implementations (sbcl) can be simplified into (require :cl-launch) You may also declare in the asdf:defsystem for your software that it :depends-on (:cl-launch ...) MAKEFILE EXAMPLES: ### Automatically download of the current version of cl-launch if not present cl-launch.sh: wget -O cl-launch.sh ${CL_LAUNCH_URL} chmod a+x cl-launch.sh ### Making a shell script executable from a simple Lisp file named foo.lisp foo.sh: cl-launch.sh foo.lisp ./cl-launch.sh --output foo.sh --file foo.lisp ### A more complex example using all options. run-foo.sh: cl-launch.sh preamble.lisp ./cl-launch.sh --output run-foo.sh --file preamble.lisp --system foo \\ --init "(foo:main cl-launch:*arguments*)" \\ --path \${PREFIX}/cl-foo/systems \\ --lisp "ccl sbcl" --wrap 'SBCL=/usr/local/bin/sbcl-no-unicode' \\ --no-include ### An example with horrible nested makefile, shell and Lisp quoting hello: opera=wORlD ; ./cl-launch.sh --execute --init \\ "(format t \\"~25R~A~A~%\\" 6873049 #\\\\space '\$\$opera)" CAVEAT LISPOR cl-launch begins evaluation of your Lisp software in the CL-USER package. By the time your initialization forms are evaluated, the package may or may not have changed, depending on the fine-grained semantics of load. Be sure to use in-package if these things matter. There are lots of ways of making mistakes by improperly quoting things when you write shell commands. cl-launch does the right thing, but you still must be careful with the nested quoting mechanisms of make, shell, and Lisp. Here is a simple example use of cl-launch to quickly compare the result of a same computation on a variety of systems: for l in sbcl cmucl clisp gcl ccl ; do ./cl-launch.sh --lisp \$l --execute --init \\ '(format t "'\$l' ~A~%" most-positive-fixnum)' ; done Internally, cl-launch includes many self-test functions. You may for instance try (from a directory where it may create junk) ./cl-launch.sh -l 'sbcl cmucl clisp gclcvs' -B tests Share and Enjoy! EOF } show_help () { print_help_header echo print_help echo print_help_footer exit "${1:-0}" } show_more_help () { print_help_header echo print_help echo print_more_help echo print_help_footer exit "${1:-0}" } error_help () { show_help "${1:-2}" >& 2 } show_version () { echo "cl-launch ${CL_LAUNCH_VERSION} Supported implementations: sbcl, cmucl (lisp), clisp, ecl, gcl (gclcvs), ccl (openmcl), allegro, lispworks Local defaults for generated scripts: will search in this order these supported implementations: ${DEFAULT_LISPS}" if [ -z "$DEFAULT_INCLUDE_PATH" ] ; then echo "\ will generate self-contained scripts using option --no-include by default" else echo "\ will generate scripts by default with runtime dependencies using option --include ${DEFAULT_INCLUDE_PATH}" fi if [ -n "$DEFAULT_USE_CL_LAUNCHRC" ] ; then echo "\ will use /etc/cl-launchrc and ~/.cl-launchrc by default" else echo "\ will not use /etc/cl-launchrc and ~/.cl-launchrc by default" fi if [ -z "$DEFAULT_USE_CLBUILD" ] ; then echo "\ will generate scripts that do not use clbuild by default" else echo "\ will generate scripts that use clbuild" fi echo exit } ### Generic debugging library excerpted from ~fare/etc/zsh/aliases.debug print_basic_functions () { cat <<'EOF' ECHOn () { printf '%s' "$*" ;} simple_term_p () { case "$1" in *[!a-zA-Z0-9-+_,.:=%/]*) return 1 ;; *) return 0 ;; esac } kwote0 () { ECHOn "$1" | sed -e "s/\([\\\\\"\$\`]\)/\\\\\\1/g" ;} kwote () { if simple_term_p "$1" ; then ECHOn "$1" ; else kwote0 "$1" ; fi ;} load_form_0 () { echo "(load $1 :verbose nil :print nil)" ;} load_form () { load_form_0 "\"$(kwote "$1")\"" ;} ECHO () { printf '%s\n' "$*" ;} DBG () { ECHO "$*" >& 2 ;} abort () { ERR="$1" ; shift ; DBG "$*" ; exit "$ERR" ;} ABORT () { abort 42 "$*" ;} EOF } eval "$(print_basic_functions)" kwote1 () { if simple_term_p "$1" ; then ECHOn "$1" else ECHOn "\"$(kwote0 "$1")\"" ; fi ;} SHOW () { ( set +x k="" ; for i ; do ECHOn "$k" ; kwote1 "$i" ; k=" " ; done ; echo ) } XDO () { SHOW "$@" >&2 ; "$@" ;} DO () { SHOW "$@" ; "$@" ;} EVAL () { ECHO "$*" ; eval "$*" ;} fullpath () { # If we were sure readlink is here, we could: for i ; do readlink -f "$i" ; done for i ; do case "$i" in /*) ECHO "$i" ;; *) ECHO "$PWD/$i" ;; esac ; done } print_var () { for var ; do eval "ECHO \"$var=\$(kwote1 \"\${$var}\")\"" ; done ;} create_file () { MOD="$1" OUT="$2" ; shift 2; TMPFILE="$OUT.tmp$$~" if "${@:-cat}" > "$TMPFILE" && chmod "$MOD" "$TMPFILE" && mv -f "$TMPFILE" "$OUT" ; then return 0 ; else rm -f "$TMPFILE" ; return 1 ; fi } ### Process options OPTION () { process_options "$@" ;} process_options () { case "$#:$1" in "1:-"*) : ;; "1:"*) add_init_form "(princ(progn $1))(terpri)" shift ;; esac while [ $# -gt 0 ] ; do x="$1" ; shift case "$x" in -h|"-?"|--help) show_help ;; -H|--more-help) show_more_help ;; -V|--version) show_version ;; -v|--verbose) export CL_LAUNCH_VERBOSE=t ;; -q|--quiet) unset CL_LAUNCH_VERBOSE ;; -f|--file) SOFTWARE_FILE="$1" shift ;; -s|--system) SOFTWARE_SYSTEM="$1" shift ;; -i|--init) add_init_form "$1" shift ;; -ip|--print) add_init_form "(princ(progn $1))(terpri)" shift ;; -iw|--write) add_init_form "(write(progn $1))(terpri)" shift ;; -p|--path) register_system_path "$1" shift 1 ;; -pc|--path-current) path_current ;; +p|--no-path) no_paths ;; -l|--lisp) LISPS="$1" shift ;; -w|--wrap) WRAPPER_CODE="$1" ; shift ;; -I|--include) INCLUDE_PATH="$1" shift ;; +I|--no-include) INCLUDE_PATH="" ;; -R|--rc) USE_CL_LAUNCHRC=t ;; +R|--no-rc) USE_CL_LAUNCHRC= ;; -b|--clbuild) USE_CLBUILD=t ;; +b|--no-clbuild) USE_CLBUILD= ;; -o|--output) OUTPUT_FILE="$1" shift ;; -x|--execute) OUTPUT_FILE="!" ;; --) if [ "x${OUTPUT_FILE}" = "x!" ] ; then do_it "$@" else ABORT "Extra arguments given but not in --execute mode" fi ;; -X) OPTION -x #OPTION -iw "cl-launch::*arguments*" OPTION -i "(cl-launch::compile-and-load-file (pop cl-launch::*arguments*))" #OPTION -i "$(load_form_0 "(pop cl-launch::*arguments*)")" ;; -X' '*) # DBG "Working around sh script script limitation..." # The below gets the script arguments from the kernel-given argument: # OPTS="$x" ; eval "OPTION $OPTS \"\$@\"" # The kernel lumps everything after the interpreter name in the #! line # into one (optional) argument. The line is limited to 127 characters, # as defined in linux/{fs/binfmt_script.c,include/linux/binfmts.h}. # If we want to allow for a longer in-script command line argument, # and we do if we want to accomodate for inline Lisp code using -i # then we'd need to go fetch the full line and parse it. Here it is: OPTS="$(get_hashbang_arguments "$1")" eval "OPTION $OPTS \"\$@\"" ABORT "The cl-launch script $1 failed to use -X ... --" ;; -u|--update) UPDATE="$1" shift ;; -m|--image) LOAD_IMAGE="$1" shift ;; -d|--dump) DUMP="$1" shift ;; -r|--restart) RESTART="$1" shift ;; -B|--backdoor) "$@" ; exit ;; -*=*) DBG "Invalid command line argument '$x'" ; mini_help_abort ;; *=*) # explicit variable definition eval "$(kwote "$x")" ;; *) DBG "Unrecognized command line argument '$x'" ; mini_help_abort ;; esac done } add_init_form () { SOFTWARE_INIT_FORMS="$SOFTWARE_INIT_FORMS${SOFTWARE_INIT_FORMS+ }$1" } get_hashbang_arguments () { cut -c3- < "$1" | { read INTERP ARGUMENTS ; ECHO "$ARGUMENTS" ;} } mini_help_abort () { DBG "$HELP_HEADER For help, invoke script with help argument: $PROG -h" ; ABORT } no_paths () { SYSTEMS_PATHS= } path_current () { register_system_path $PWD } register_system_path () { NEW_PATH="$(make_system_path "$1")" SYSTEMS_PATHS="$SYSTEMS_PATHS $NEW_PATH" } make_system_path () { if simple_term_p "$1" ; then ECHOn "#P\"$(kwote "${1%/}/")\"" else ECHOn "$1" fi } ### Do the job guess_defaults () { if [ -n "$UPDATE" ] ; then SOFTWARE_FILE= : "${OUTPUT_FILE:=$UPDATE}" fi LISP_CONTENT="$SOFTWARE_FILE" } # Configuration system_preferred_lisps () { if [ "x${SOFTWARE_SYSTEM}" = "x$1" ] ; then shift LISPS="$*" DBG "User configuration for system ${SOFTWARE_SYSTEM} overrides LISPS with $(kwote1 "$LISPS")" fi } try_resource_file () { if [ -f "$1" ] ; then . "$1" fi } try_resource_files () { if [ -n "$USE_CL_LAUNCHRC" ] ; then try_resource_file /etc/cl-launchrc try_resource_file "$HOME/.cl-launchrc" fi } print_configuration () { print_var \ SOFTWARE_FILE SOFTWARE_SYSTEM SOFTWARE_INIT_FORMS \ SYSTEMS_PATHS INCLUDE_PATH LISPS WRAPPER_CODE \ DUMP RESTART IMAGE_BASE IMAGE_DIR IMAGE \ $EXTRA_CONFIG_VARIABLES } include_configuration () { if [ -n "$UPDATE" ] ; then extract_configuration ECHO "$CONFIGURATION" eval "$CONFIGURATION" else extract_configuration print_configuration fi } ensure_configuration () { extract_configuration if [ -n "$UPDATE" ] ; then eval "$CONFIGURATION" adjust_configuration fi } adjust_configuration () { : INCLUDE_PATH="$INCLUDE_PATH" SOFTWARE_FILE="$SOFTWARE_FILE" if [ -n "$INCLUDE_PATH" ] ; then AUTHOR_NOTE= SHORT_LICENSE= LICENSE_COMMENT= fi case "$SOFTWARE_FILE" in ""|/dev/null) LISP_CONTENT= ;; /*) if [ -n "$INCLUDE_PATH" ] ; then LISP_CONTENT= else LISP_CONTENT="$SOFTWARE_FILE" SOFTWARE_FILE="." fi ;; .) LISP_CONTENT= SOFTWARE_FILE="." ;; -) LISP_CONTENT= SOFTWARE_FILE="-" ;; *) LISP_CONTENT="$SOFTWARE_FILE" SOFTWARE_FILE="." ;; esac : LISP_CONTENT="$LISP_CONTENT" SOFTWARE_FILE="$SOFTWARE_FILE" } include_license () { if [ -n "$DISCLAIMER" ] ; then l= for i in "$DISCLAIMER" "$AUTHOR_NOTE" "$SHORT_LICENSE" "$LICENSE_COMMENT" do l="$l$i${i:+# }" ; done ECHOn "$l" fi hide_license } hide_license () { DISCLAIMER= AUTHOR_NOTE= SHORT_LICENSE= LICENSE_COMMENT= CONTENT_DISCLAIMER= } include_lisp_header () { if [ -z "$INCLUDE_PATH" ] ; then print_lisp_header else load_form "$INCLUDE_PATH/launcher.lisp" fi } LAUNCH_FUN=cl-launch::run print_lisp_launch () { ECHOn "($LAUNCH_FUN" if [ -n "${SYSTEMS_PATHS}" ] ; then ECHOn " :paths '(${SYSTEMS_PATHS})" fi case "${SOFTWARE_FILE}" in /dev/null|"") : ;; -) ECHOn " :load t" ;; .) ECHOn " :load :self" ;; *) ECHOn " :load \"$(kwote "$SOFTWARE_FILE")\"" esac if [ -n "${SOFTWARE_SYSTEM}" ] ; then ECHOn " :system :${SOFTWARE_SYSTEM}" fi if [ -n "${SOFTWARE_INIT_FORMS}" ] ; then ECHOn " :init \"$(kwote "${SOFTWARE_INIT_FORMS}")\"" fi if [ -n "${NO_QUIT}" ] ; then ECHOn " :quit nil" fi if [ -n "${DUMP}" ] ; then ECHOn " :dump \"$(kwote "${DUMP}")\"" fi if [ -n "${RESTART}" ] ; then ECHOn " :restart \"$(kwote "${RESTART}")\"" fi ECHOn ")" } print_lisp_initialization () { echo "#-cl-launched" print_lisp_launch } print_lisp_content () { ECHO "$CONTENT_DISCLAIMER" ECHO "$CONTENT_BEGIN_MARKER" extract_lisp_content } include_lisp_content () { if [ "$SOFTWARE_FILE" = . ] ; then print_lisp_content ; fi } include_shell_wrapper () { ECHO "$BASIC_ENV_CODE" if [ -z "$INCLUDE_PATH" ] ; then print_shell_wrapper else ECHO ". $(kwote1 "$INCLUDE_PATH/wrapper.sh")" fi } include_script_configuration_and_headers () { ECHOn "\ #!/bin/sh #| CL-LAUNCH ${CL_LAUNCH_VERSION} CONFIGURATION " ; include_configuration ; ECHOn "\ # END OF CL-LAUNCH CONFIGURATION # This file was generated by CL-Launch ${CL_LAUNCH_VERSION} " ; include_license } make_loader () { include_script_configuration_and_headers include_shell_wrapper ECHOn ' launch_self "$@" ABORT # |# ' ; include_lisp_stuff } include_lisp_stuff () { include_lisp_header ; ECHOn ' ;;;; CL-LAUNCH LISP INITIALIZATION CODE ' ; print_lisp_initialization ; ECHOn ' ;;;; END OF CL-LAUNCH LISP INITIALIZATION CODE ' ; include_lisp_content } READ () { if [ $UNREAD_DEPTH = 0 ] ; then read -r LINE elif [ $UNREAD_DEPTH = 1 ] ; then UNREAD_DEPTH=0 LINE="$LINE1" elif [ $UNREAD_DEPTH = 2 ] ; then UNREAD_DEPTH=1 LINE="$LINE1" LINE1="$LINE2" else ABORT "error: UNREAD_DEPTH=$UNREAD_DEPTH" fi } UNREAD () { if [ $UNREAD_DEPTH = 0 ] ; then UNREAD_DEPTH=1 LINE1="$1" elif [ $UNREAD_DEPTH = 1 ] ; then UNREAD_DEPTH=2 LINE2="$LINE1" LINE1="$1" else ABORT "error: UNREAD_DEPTH=$UNREAD_DEPTH" fi } extract_configuration () { TRIED_CONFIGURATION=t CONFIGURATION= READ || return : "READ => $LINE" L1="#!/bin/sh" case "$LINE" in "$L1") : "read the SHEBANG" ;; *) : "Not a shell script" ; UNREAD "$LINE" ; return 2 ;; esac if ! READ ; then UNREAD "$L1" ; return 2 ; fi : "READ => $LINE" case "$LINE" in "#| CL-LAUNCH"*" CONFIGURATION") : "read the CL comment start" ;; *) : "Not a CL-Launch script" ; UNREAD "$LINE" ; UNREAD "$L1" ; return 2 ;; esac while READ && #: "READ => $LINE" && case "$LINE" in "# END OF CL-LAUNCH CONFIGURATION") ! : ;; *) : ;; esac do CONFIGURATION="$CONFIGURATION${CONFIGURATION:+ }$LINE" ; done HAS_CONFIGURATION=t } extract_lisp_content () { if [ -z "$TRIED_CONFIGURATION" ] ; then extract_configuration fi if [ -n "$HAS_CONFIGURATION" ] ; then skip_to_marker fi cat_with_unread } cat_with_unread () { while [ $UNREAD_DEPTH != 0 ] ; do READ : "READ => $LINE" ECHO "$LINE" done cat } skip_to_marker () { while READ && #: "READ => $LINE" && case "$LINE" in "$CONTENT_BEGIN_MARKER") ! : ;; *) : ;; esac do : ; done } create_output () { create_file 755 "$OUTPUT_FILE" "$@" } with_input_from () { IN="$1" ; shift case "$IN" in ""|/dev/null) : from null ; "$@" < /dev/null ;; -) : from stdin ; "$@" ;; *) : from file "$IN" ; "$@" < "$IN" ;; esac } with_input () { with_input_from "${UPDATE:-$LISP_CONTENT}" "$@" } with_output () { case "${OUTPUT_FILE}" in "") ABORT "output file not specified" ;; /dev/null) : ;; -) "$@" ;; *) create_output "$@" ;; esac } make_output_file () { if [ -n "$DUMP" ] ; then dump_image_and_continue else do_make_output_file fi } do_make_output_file () { with_output with_input make_loader } execute_code () { run_code "$@" } do_run_code () { eval "$(print_shell_wrapper_body)" if [ -n "$LISP_CONTENT" ] ; then export CL_LAUNCH_FILE="$LISP_CONTENT" else unset CL_LAUNCH_FILE fi LAUNCH_FUN='funcall(intern(string :run):cl-launch)' LAUNCH_FORMS="$(load_form "$PROG";print_lisp_launch)" try_all_lisps "$@" } run_code () { ### Note: when dumping an image, run_code gets locally redefined ### by do_dump_image_and_continue, and restored by do_dump_image do_run_code "$@" } dump_image_and_continue () { case "$UPDATE" in -) SOFTWARE_CODE="$(cat)" ECHO "$SOFTWARE_CODE" | do_dump_image_and_continue "$@" ;; *) do_dump_image_and_continue "$@" ;; esac } do_dump_image_and_continue () { ORIG_WRAPPER_CODE="$WRAPPER_CODE" run_code () { WRAPPER_CODE="$WRAPPER_CODE DO_LISP=do_dump_image" do_run_code "$@" } if [ "x$DUMP" = "x!" ] ; then if [ "x$OUTPUT_FILE" = "x!" ] ; then abort 14 "Image dump required but neither dump file nor output file specified" else DUMP="$OUTPUT_FILE" fi fi IMAGE= execute_code "$@" } do_dump_image () { : do_dump_image "$@" run_code () { do_run_code "$@" } if [ -n "$INCLUDE_PATH" ] ; then export CL_LAUNCH_HEADER="$INCLUDE_PATH/launcher.lisp" else export CL_LAUNCH_HEADER="$PROG" fi if [ "x$IMAGE_ARG" = "xNOT_SUPPORTED_YET" ] ; then abort 13 "Image dumping not supported with implementation $IMPL. Try specifying a supported implementation with option --lisp (or \$LISP)" fi if [ -n "$STANDALONE_EXECUTABLE" ] ; then if [ "x$DUMP" = "x$OUTPUT_FILE" ] ; then # disabled optimization: also for || [ "x$OUTPUT_FILE" = "x!" ] # as it doesn't play nice with older versions of SBCL, ECL, etc., # that do not support standalone executables. export CL_LAUNCH_STANDALONE=t fi else if [ "x$DUMP" = "x$OUTPUT_FILE" ] ; then abort 15 "This implementation does not support dumping a standalone executable image" fi fi license_information # Use LOAD_IMAGE if it exists compute_image_path "$LOAD_IMAGE" ( do_exec_lisp ) || abort 22 "Failed to dump an image" case "$UPDATE" in -) ECHO "$SOFTWARE_CODE" | use_dumped_image "$@" ;; *) use_dumped_image "$@" ;; esac } use_dumped_image () { : use_dumped_image $OUTPUT_FILE compute_image_path "$DUMP" case "${CL_LAUNCH_STANDALONE}:${OUTPUT_FILE}" in :!) invoke_image "$@" ;; :*) make_image_invoker ;; t:!) if [ -n "$CL_LAUNCH_VERBOSE" ] ; then set -x ; fi ; ${IMAGE} "$@" ;; t:*) ;; esac } make_image_invoker () { WRAPPER_CODE="$ORIG_WRAPPER_CODE" with_output with_input make_image_invocation_script } compute_image_path () { if [ -n "$1" ] ; then IMAGE_BASE="$(basename "$1")" IMAGE_DIR="${INCLUDE_PATH:-$(dirname "$1")}" IMAGE=${IMAGE_DIR}/${IMAGE_BASE} else IMAGE_BASE= IMAGE_DIR= IMAGE= fi } prepare_invocation_configuration () { LISP=$IMPL EXTRA_CONFIG_VARIABLES="LISP $OPTIONS_ARG" if eval "[ -n \"\$$BIN_ARG\" ]" ; then EXTRA_CONFIG_VARIABLES="$EXTRA_CONFIG_VARIABLES $BIN_ARG" fi } make_image_invocation_script () { prepare_invocation_configuration include_script_configuration_and_headers make_image_invocation include_lisp_content } make_image_invocation () { include_shell_wrapper if [ "x$IMAGE_ARG" = xEXECUTABLE_IMAGE ] ; then echo "$BIN_ARG=$IMAGE" fi cat<&2 t_args "--include ..." t_next "$@" --include "$PWD" } t_inc1 () { TFILE=clt-src.lisp ; t_inc "$@" } t_inc2 () { TINC2=t TFILE="$PWD/clt-src.lisp" ; t_inc "$@" } t_noinc () { t_args "--no-include" t_next "$@" --no-include } t_update () { t_args "--update ..." TORIG=$CLOUT.orig ; cp -f $CLOUT $TORIG t_next "$@" --update $CLOUT } t_noupdate () { TORIG= t_next "$@" } t_end_out () { t_args "--output ... ; out.sh ..." TOUT=$CLOUT t_make "$@" --output $CLOUT t_check $CLOUT } t_end_exec () { t_args "--execute -- ..." t_check t_make "$@" --execute -- } t_make () { XDO t_$TEST_SHELL -x $PROG "$@" } t_check () { echo "cl-launch $ARGS" PATH=.:$PATH "$@" "won" | tee clt.log >&2 : RESULTS: "$(cat clt.log)" if [ -n "$TORIG" ] && [ -n "$TOUT" ] && ! cmp --quiet $TOUT $TORIG ; then echo "the updated file differs from the original one, although execution might not show the difference. Double check that with: diff -uN $TORIG $TOUT | less - $TORIG " t_check_failed elif [ 0 = "$(grep -c OK < clt.log)" ] || [ 0 != "$(grep -ci error < clt.log)" ] ; then t_check_failed else t_check_success fi } t_check_success () { echo "success with test $NUM :-)" return 0 } t_check_failed () { echo "FAILURE with test $NUM :-(" [ -n "$NUM" ] && echo "You may restart from this test with: $PROG -l $(kwote1 "$LISPS") -B tests $NUM or $PROG -l $(kwote1 "$LISPS") -B tests $(printf %02d $(( ( $num / 4 ) * 4 )) )" [ -n "$TCURR" ] && echo "You may re-run just this test with: $PROG -B redo_test $TEST_SHELL $LISP $TCURR" [ -n "$NO_STOP" ] || ABORT "FIX THAT BUG!" } t_out () { t_env ; TEXEC= ; t_begin "$@" } t_exec () { t_env ; TEXEC=t ; t_begin "$@" } clisp_tests () { LISPS=clisp ; tests "$@" ;} all_tests () { NO_STOP=t ; tests "$@" ;} tests () { do_tests "$@" 2> tests.log } detect_program () { which "$1" 2>&1 > /dev/null } detect_shells () { # add something wrt ksh, pdksh ? TEST_SHELLS= for i in sh posh dash zsh pdksh bash busybox ; do if detect_program $i ; then TEST_SHELLS="$TEST_SHELLS $i" fi done } t_sh () { sh "$@" ;} t_bash () { bash "$@" ;} t_posh () { posh "$@" ;} t_pdksh () { pdksh "$@" ;} t_dash () { dash "$@" ;} t_zsh () { zsh -fy "$@" ;} t_busybox () { busybox sh "$@" ;} shell_tests () { detect_shells tests "$@" } do_tests () { if [ -n "$TEST_SHELLS" ] ; then echo "Using test shells $TEST_SHELLS" fi t_env num=0 MIN=${1:-0} MAX=${2:-999999} export LISP # Use this with # cl-launch.sh -B test # beware, it will clobber then remove a lot of file clt-* # and exercise your Lisp fasl cache for LISP in $LISPS ; do for TEST_SHELL in ${TEST_SHELLS:-${TEST_SHELL:-sh}} ; do echo "Using test shell $TEST_SHELL" for TM in "" "image " ; do for TD in "" "dump " "dump_ " ; do for IF in "noinc" "noinc file" "inc" "inc1 file" "inc2 file" ; do TDIF="$TM$TD$IF" for TS in "" " system" ; do TDIFS="$TDIF$TS" case "$TD:$TS:$LISP" in *:" system:gcl") ;; # no ASDF for GCL 2.6 dump_*:cmucl*|dump_*:gcl*|dump_*:allegro|dump_*:ccl|dump_*:clisp) : invalid or unsupported combo ;; # actually only available for ecl and sbcl *) for TI in "noinit" "init" ; do TDIFSI="$TDIFS $TI" case "$TDIFSI" in *"inc noinit") : skipping invalid combination ;; *) for TU in "noupdate" "update" ; do TUDIFSI="$TU $TDIFSI" for TO in "exec" "out" ; do case "$TU:$TO:$TD" in update:*:dump_*) : invalid combo ;; *:exec:dump_*) : invalid combo ;; *) TEUDIFSI="$TO $TUDIFSI" do_test $TEUDIFSI ;; esac ; done ; done ;; esac ; done ;; esac ; done ; done ; done ; done ; done ; done } redo_test () { export TEST_SHELL="$1" LISPS="$2" LISP="$2" ; shift 2 do_test "$@" } do_test () { if [ $MIN -le $num ] && [ $num -le $MAX ] ; then TCURR="$*" if [ -n "$num" ] ; then NUM=$(printf "%02d" $num) case "$*" in *out*noupdate*) # If we don't clean between runs of test/update, then # we have bizarre transient failures at test 12 or 40 when we e.g. # DEBUG_RACE_CONDITION=t cl-launch -l clisp -B tests 8 12 # There is some race condition somewhere in the cacheing layer, # and even though (trace ...) shows that cl-launch does try to # recompile then file, when it loads, it still find the old version in the cache. [ -n "$DEBUG_RACE_CONDITION" ] || test_clean ;; esac fi eval "$(for i ; do ECHOn " t_$i" ; done)" fi num=$(($num+1)) } test () { tests $@ && test_clean } test_clean () { rm -rfv clt* ~/.cache/lisp-fasl/*/$(pwd)/clt* >&2 } fakeccl () { DO export LISP=ccl CCL=sbcl CCL_OPTIONS="--noinform --sysinit /dev/null --userinit /dev/null --eval (make-package':ccl) --eval (setf(symbol-function'ccl::quit)(symbol-function'sb-ext:quit)) --eval (setf(symbol-function'ccl::getenv)(symbol-function'sb-ext:posix-getenv))" OPTION "$@" } update () { wget -O cl-launch.sh "${CL_LAUNCH_URL}" chmod a+x cl-launch.sh } install () { if [ -z "$INCLUDE_PATH" ] || [ -z "$OUTPUT_FILE" ] ; then ABORT "example usage: $PROG -I /usr/share/common-lisp/source/cl-launch \\ -l '$DEFAULT_LISPS' \\ -o /usr/bin/cl-launch -B install" fi install_path install_bin } print_cl_launch_asd () { cat< $LOADFILE < /dev/null`" ; then return 0 else return 1 fi } trylisp () { IMPL="$1" ; shift implementation_${IMPL} "$@" } do_exec_lisp () { if [ -n "$IMAGE" ] ; then if [ "x$IMAGE_ARG" = xEXECUTABLE_IMAGE ] ; then LISP_BIN= IMAGE_OPT= else IMAGE_OPT="$IMAGE_ARG" fi fi $EXEC_LISP "$@" } no_implementation_found () { ABORT "$PROG: Cannot find a supported lisp implementation. Tried the following: $*" } ensure_implementation () { trylisp "$1" || no_implementation_found "$1" } try_all_lisps () { for l in $LISP $LISPS ; do if trylisp $l ; then $DO_LISP "$@" return 0 fi done no_implementation_found "$LISP $LISPS" } exec_lisp () { # SBCL wants only one form per --eval so we need put everything in one progn. # However we also want any in-package form to be evaluated before any of the # remaining forms is read, so we get it to be evaluated at read-time as the # first thing in the main progn. # GNU clisp allows multiple forms per -x but prints the result of every form # evaluated and so we also need put everything in a single progn, and that progn # must quit before it may return to the clisp frame that would print its value. # CMUCL allows multiple forms per -eval and won't print values, so is ok anyway. # I don't know about other Lisps, but they will all work this way. LAUNCH_FORM="${PROGN}${MAYBE_PACKAGE_FORM}${HASH_BANG_FORM}${LAUNCH_FORMS}${NGORP}" ### This is partial support for CLBUILD. if [ -n "$USE_CLBUILD" ] ; then if [ -z "$IMAGE_OPT" ] ; then OPTIONS= else ABORT "Cannot use clbuild with a non-executable image different from clbuild's" fi fi if [ -n "$CL_LAUNCH_VERBOSE" ] ; then set -x ; fi exec $LISP_BIN $IMAGE_OPT $IMAGE $OPTIONS $EVAL "$LAUNCH_FORM" $ENDARGS "$@" } launch_self () { LAUNCH_FORMS="$(load_form "$PROG")" try_all_lisps "$@" } invoke_image () { if [ "x$IMAGE_ARG" = xEXECUTABLE_IMAGE ] ; then LISP_BIN= IMAGE_OPT= else IMAGE_OPT="$IMAGE_ARG" fi PACKAGE_FORM= HASH_BANG_FORM= LAUNCH_FORMS="(cl-launch::resume)" "$EXEC_LISP" "$@" } export CL_LAUNCH_PID=$$ export CL_LAUNCH_FILE="$PROG" ## execute configuration-provided code eval "$WRAPPER_CODE" ### END OF CL-LAUNCH SHELL WRAPPER EOF } : ' Useful tidbit for dichotomy-debugging Lisp code: (defvar *x* 0) (defun xx () (format t "*x* ~D~%" (incf *x*) (finish-output))) (xx) (xx) ' cl_fragment () { if [ -n "$CL_HEADER" ] ; then ECHOn "#-cl-launch " fi cat } print_lisp_header () { CL_HEADER=t print_lisp_code echo ";;;;; Return to the default package." echo "(in-package :cl-user)" print_lisp_code_bottom } print_lisp_launcher () { CL_HEADER= print_lisp_code echo ; echo "(compute-arguments)" print_lisp_code_bottom } print_lisp_code () { echo "#+xcvb (module ())" echo "#| ;;; cl-launch ${CL_LAUNCH_VERSION} lisp header" include_license # HACK: this whole file is itself readable as Lisp code, and its meaning # is then that of the cl-launch lisp header code enclosed herein. # |# Last bit of Karma cat<<'NIL' |# ;;;; Silence our lisp implementation for quiet batch use... #| We'd like to evaluate as little as possible of the code without compilation. This poses a typical bootstrapping problem: the more sophistication we want to distinguish what to put where in what dynamic environment, the more code we have to evaluate before we may actually load compiled files. And, then, it is a waste of time to try to compile said code into a file. Moving things to the shell can only help so much, and reduces flexibility. Our best bet is to tell sbcl or cmucl to not try to optimize too hard. |# NIL ":" ; cl_fragment<<'NIL' (eval-when (:load-toplevel :execute :compile-toplevel) (declaim (optimize (speed 1) (safety 2) (compilation-speed 3) #-gcl (debug 1) #+sbcl (sb-ext:inhibit-warnings 3) #+sbcl (sb-c::merge-tail-calls 3) ;-- this plus debug 1 (or sb-c::insert-debug-catch 0 ???) should ensure all tail calls are optimized, says jsnell #+cmu (ext:inhibit-warnings 3))) #+gcl ;;; If using GCL, do some safety checks (when (or #-ansi-cl t) (format *error-output* "CL-Launch only supports GCL in ANSI mode. Aborting.~%") (lisp:quit)) #+gcl (when (or (< system::*gcl-major-version* 2) (and (= system::*gcl-major-version* 2) (< system::*gcl-minor-version* 7))) (pushnew :gcl-pre2.7 *features*)) (setf *print-readably* nil ; allegro 5.0 notably will bork without this *load-verbose* nil *compile-verbose* nil *compile-print* nil) #+cmu (setf ext:*gc-verbose* nil) #+clisp (setf custom:*source-file-types* nil custom:*compiled-file-types* nil) #+gcl (setf compiler::*compiler-default-type* (pathname "") compiler::*lsp-ext* "") #+ecl (require 'cmp) ;;;; Ensure package hygiene (unless (find-package :cl-launch) (if (find-package :common-lisp) (defpackage :cl-launch (:use :common-lisp)) (make-package :cl-launch :use '(:lisp)))) (in-package :cl-launch)) NIL ":" ; cl_fragment<<'NIL' (defmacro dbg (tag &rest exprs) "simple debug statement macro: outputs a tag plus a list of source expressions and their resulting values, returns the last values" (let ((res (gensym))(f (gensym))) `(let ((,res)) (flet ((,f (fmt &rest args) (apply #'format *trace-output* fmt args))) (,f "~&~A~%" ,tag) ,@(mapcan #'(lambda (x) `((,f "~& ~S => " ',x) (,f "~{~S~^ ~}~%" (setf ,res (multiple-value-list ,x))))) exprs) (apply 'values ,res))))) NIL ":" ; cl_fragment<<'NIL' (eval-when (:load-toplevel :execute :compile-toplevel) ;; Import a few symbols if needed #+common-lisp-controller (map () #'import '(clc::*source-root* clc::*fasl-root* clc::calculate-fasl-root clc::source-root-path-to-fasl-path clc::alternative-root-path-to-fasl-path clc::*redirect-fasl-files-to-cache*)) ;;; define getenv and quit in ways that minimize package conflicts ;;; (use-package :cl-launch) while in cl-user. #+(or clozure allegro gcl clisp ecl) (import '#+clozure ccl::getenv #+allegro sys:getenv #+gcl system:getenv #+clisp ext:getenv #+ecl si:getenv :cl-launch) #+(or cmu sbcl lispworks) (defun getenv (x) #+sbcl (sb-ext:posix-getenv x) #+lispworks (lispworks:environment-variable x) #+cmu (cdr (assoc (intern x :keyword) ext:*environment-list*))) (defun quit (&optional (code 0) (finish-output t)) (when finish-output ;; essential, for ClozureCL, and for standard compliance. (finish-outputs)) #+cmu (unix:unix-exit code) #+clisp (ext:quit code) #+sbcl (sb-unix:unix-exit code) #+clozure (ccl:quit code) #+gcl (lisp:quit code) #+allegro (excl:exit code :quiet t) #+ecl (si:quit code) #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t) #-(or cmu clisp sbcl clozure gcl allegro ecl lispworks) (error "Quitting not implemented"))) NIL ":" ; cl_fragment<<'NIL' (eval-when (:load-toplevel :execute :compile-toplevel) ;;;; Load ASDF (ignore-errors (require :asdf)) ;;; Here is a fallback plan in case the lisp implementation isn't asdf-aware. (unless (and (find-package :asdf) (find-symbol "OUTPUT-FILES" :asdf)) (defvar *asdf-path* (or (and (getenv "ASDF_PATH") (probe-file (getenv "ASDF_PATH"))) (probe-file (merge-pathnames "src/asdf/asdf.lisp" (user-homedir-pathname))) (probe-file "/usr/share/common-lisp/source/cl-asdf/asdf.lisp") (probe-file "/usr/share/common-lisp/source/asdf/asdf.lisp"))) (when *asdf-path* (ignore-errors (load *asdf-path* :verbose nil :print nil))))) NIL ":" ; cl_fragment<<'NIL' (eval-when (:load-toplevel :execute :compile-toplevel) ;;; Even in absence of asdf, at least create a package asdf. (unless (find-package :asdf) (make-package :asdf))) NIL ":" ; cl_fragment<<'NIL' (eval-when (:load-toplevel :execute :compile-toplevel) ;;; Try to share this with asdf, in case we get asdf to support it one day. (map () #'import '(asdf::*output-pathname-translations* asdf::resolve-symlinks asdf::oos asdf::load-op asdf::find-system))) ;;;; CL-Launch Initialization code NIL ":" ; cl_fragment<<'NIL' (progn (pushnew :cl-launch *features*) ;;#+ecl (require 'cmp) ; ensure we use the compiler (we use e.g. *ecl-library-directory*) (dolist (s '(*arguments* getenv quit compile-and-load-file compile-file-pathname* apply-pathname-translations *output-pathname-translations* apply-output-pathname-translations)) (export s)) ;; To dynamically recompute from the environment at each invocation (defvar *cl-launch-file* nil) (defvar *verbose* nil) (defvar *lisp-fasl-cache* nil "lisp fasl cache hierarchy") (defvar *lisp-fasl-root* nil "top path for the fasl cache for current implementation") ;; To dynamically recompute from the command-line at each invocation (defvar *arguments* nil "command-line parameters") ;; Variables that define the current system (defvar *dumped* nil) (defvar *restart* nil) (defvar *init-forms* nil) (defvar *quit* t) ;; Provide compatibility with clc 6.2 (defvar *redirect-fasl-files-to-cache* t) (defun raw-command-line-arguments () nil #+ecl (loop for i from 0 below (si:argc) collect (si:argv i)) #+gcl si:*command-args* #+cmu extensions:*command-line-strings* #+clozure ccl:*unprocessed-command-line-arguments* #+sbcl sb-ext:*posix-argv* #+allegro sys:command-line-arguments #+lispworks sys:*line-arguments-list* #+clisp (cons "--" ext:*args*)) (defun command-line-arguments () (let* ((raw (raw-command-line-arguments)) (cooked #+sbcl raw #-sbcl (if (eq *dumped* :standalone) raw (member "--" raw :test 'string-equal)))) (cdr cooked))) #+gcl-pre2.7 (defun ensure-directories-exist (x) "hope for the best" nil) (defvar *implementation-name* nil "The name of the implementation, used to make a directory hierarchy for fasl files") (defvar *temporary-directory* "/tmp/" "The name of the implementation, used to make a directory hierarchy for fasl files") (defun compute-arguments () (setf *cl-launch-file* (getenv "CL_LAUNCH_FILE") *temporary-directory* (ensure-directory-name (or (getenv "TMP") "/tmp")) #+gcl #+gcl system::*tmp-dir* *temporary-directory* ; basic lack fixed after gcl 2.7.0-61, but ending / required still on 2.7.0-64.1 *verbose* (when (getenv "CL_LAUNCH_VERBOSE") t) *implementation-name* (unique-directory-name #-ecl *verbose*) *lisp-fasl-cache* (let* ((cache-env (getenv "LISP_FASL_CACHE")) (cache-spec (cond ((null cache-env) (merge-pathnames #p".cache/lisp-fasl/" ;;(make-pathname :directory (list :relative ".cache" "lisp-fasl")) (user-homedir-pathname))) ((equal cache-env "NIL") nil) (t (dirname->pathname cache-env))))) (when cache-spec (ensure-directories-exist cache-spec) (resolve-symlinks cache-spec))) *lisp-fasl-root* (let* ((root-env (when (getenv "LISP") (let ((r (getenv "LISP_FASL_ROOT"))) (when r (if (equal r "NIL") :disabled (dirname->pathname r)))))) (root-spec (or root-env (when *lisp-fasl-cache* (merge-pathnames (make-pathname :directory (list :relative *implementation-name*)) *lisp-fasl-cache*))))) (when root-spec (ensure-directories-exist root-spec) (resolve-symlinks root-spec)))) (calculate-output-pathname-translations) (setf *arguments* (or *arguments* (command-line-arguments)))) (defun register-paths (paths) #-asdf (declare (ignore paths)) #+asdf (dolist (p (reverse paths)) (pushnew p asdf::*central-registry* :test 'equal))) (defun load-stream (&optional (s #-clisp *standard-input* #+clisp *terminal-io*)) ;; GCL 2.6 can't load from a string-input-stream ;; ClozureCL 1.2 cannot load from either *standard-input* or *terminal-io* ;; Allegro 5, I don't remember but it must have been broken when I tested. #+(or gcl-pre2.7 clozure allegro) (do ((eof '#:eof) (x t (read s nil eof))) ((eq x eof)) (eval x)) #-(or gcl-pre2.7 clozure allegro) (load s :verbose nil :print nil)) (defun load-string (string) (with-input-from-string (s string) (load-stream s))) (defun finish-outputs () (finish-output *error-output*) (finish-output)) (defun %abort (code fmt &rest args) (apply #'format *error-output* fmt args) (quit code)) (defun resume () (compute-arguments) (do-resume)) (defun do-resume () (when *restart* (funcall *restart*)) (when *init-forms* (load-string *init-forms*)) (finish-outputs) (when *quit* (quit 0))) (defun dump-image (filename &key standalone (package :cl-user)) (setf *dumped* (if standalone :standalone :wrapped) *arguments* nil *package* (find-package package) *features* (remove :cl-launched *features*)) #+clisp (apply #'ext:saveinitmem filename :quiet t :start-package *package* :keep-global-handlers nil :executable (if standalone 0 t) ;--- requires clisp 2.48 or later. (when standalone (list :norc t :script nil :init-function #'resume ;; :parse-options nil ;--- requires a non-standard patch to clisp. ))) #+sbcl (progn ;;(sb-pcl::precompile-random-code-segments) ;--- it is ugly slow at compile-time (!) when the initial core is a big CLOS program. If you want it, do it yourself (setf sb-ext::*gc-run-time* 0) (apply 'sb-ext:save-lisp-and-die filename :executable t ;--- always include the runtime that goes with the core (when standalone (list :toplevel #'resume :save-runtime-options t)))) ;--- only save runtime-options for standalone executables #+cmu (progn (ext:gc :full t) (setf ext:*batch-mode* nil) (setf ext::*gc-run-time* 0) (extensions:save-lisp filename)) #+clozure (ccl:save-application filename :prepend-kernel t) #+allegro (progn (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) ; :new 5000000 (excl:dumplisp :name filename :suppress-allegro-cl-banner t)) #+lispworks (if standalone (lispworks:deliver 'resume filename 0 :interface nil) (hcl:save-image filename :environment nil)) #+gcl (progn (si::set-hole-size 500) (si::gbc nil) (si::sgc-on t) (si::save-system filename)) #-(or clisp sbcl cmu clozure allegro gcl lispworks) (%abort 11 "CL-Launch doesn't supports image dumping with this Lisp implementation.~%")) (defun run (&key paths load system dump restart init (quit 0)) (pushnew :cl-launched *features*) (compute-arguments) (when paths (register-paths paths)) (if dump (build-and-dump dump load system restart init quit) (build-and-run load system restart init quit))) (defun read-function (string) (eval `(function ,(read-from-string string)))) #-(and gcl (not gcl-pre2.7)) (defun build-and-load (load system restart init quit) (do-build-and-load load system restart init quit)) #+(and gcl (not gcl-pre2.7)) (defun build-and-load (load system restart init quit) (unwind-protect (do-build-and-load load system restart init quit) (cleanup-temporary-files))) (defun do-build-and-load (load system restart init quit) (when load (cond ((eq load t) (load-stream)) ((streamp load) (load-stream load)) ((eq load :self) (load-file *cl-launch-file*)) (t (load-file load)))) (when system #+asdf (load-system system :verbose *verbose*) #-asdf (%abort 10 "ERROR: asdf requested, but not found~%")) (setf *restart* (when restart (read-function restart)) *init-forms* init *quit* quit)) (defun build-and-run (load system restart init quit) (build-and-load load system restart init quit) (do-resume)) #-ecl (defun build-and-dump (dump load system restart init quit) (build-and-load load system restart init quit) (dump-image dump :standalone (getenv "CL_LAUNCH_STANDALONE")) (quit)) #+(or ecl (and gcl (not gcl-pre2.7))) (progn (defvar *temporary-filenames* nil) (defun copy-stream (i o &key (element-type 'character)) (loop with size = 8192 with buf = (make-array size :element-type element-type) for n = (read-sequence buf i) while (plusp n) do (write-sequence buf o :end n))) (defun call-with-new-file (n f) (with-open-file (o n :direction :output :if-exists :error :if-does-not-exist :create) (funcall f o))) (defun dump-stream-to-file (i n) (call-with-new-file n (lambda (o) (copy-stream i o)))) (defun copy-file (src dst) (with-open-file (i src :direction :input :if-does-not-exist :error :element-type '(unsigned-byte 8)) (with-open-file (o dst :direction :output :if-exists :supersede :element-type '(unsigned-byte 8)) (copy-stream i o :element-type '(unsigned-byte 8))))) (defun dump-sexp-to-file (x n) (call-with-new-file n (lambda (o) (write x :stream o :pretty t :readably t)))) (defvar *temporary-file-prefix* (format nil "~Acl-launch-~A-" *temporary-directory* (getenv "CL_LAUNCH_PID"))) (defun make-temporary-filename (x) (concatenate 'string *temporary-file-prefix* x)) (defun register-temporary-filename (n) (push n *temporary-filenames*) n) (defun temporary-filename (x) (register-temporary-filename (make-temporary-filename x))) (defun temporary-file-from-foo (dumper arg x) (let ((n (temporary-filename x))) (funcall dumper arg n) n)) (defun temporary-file-from-stream (i x) (temporary-file-from-foo #'dump-stream-to-file i x)) (defun temporary-file-from-sexp (i x) (temporary-file-from-foo #'dump-sexp-to-file i x)) (defun temporary-file-from-file (f x) (with-open-file (i f :direction :input :if-does-not-exist :error) (temporary-file-from-stream i x))) (defun ensure-lisp-file (x &optional (name "load.lisp")) (cond ((eq x t) (temporary-file-from-stream *standard-input* "load.lisp")) ((streamp x) (temporary-file-from-stream x "load.lisp")) ((eq x :self) (ensure-lisp-file-name *cl-launch-file* name)) (t (ensure-lisp-file-name x name)))) (defun ensure-lisp-file-name (x &optional (name "load.lisp")) (let ((p (pathname x))) (if (equal (pathname-type p) "lisp") p (temporary-file-from-file p name)))) (defun cleanup-temporary-files () (loop for n = (pop *temporary-filenames*) while n do (ignore-errors (delete-file n))))) ;;; choose which strategy you try to debug... #+ecl (defun build-and-dump (&rest r) (apply #'yyy-build-and-dump r)) ;;; Attempt at adapting the code from cl-launch 2.07 ;;; seems to break earlier than the yyy- method below. #+ecl (defun xxx-build-and-dump (dump load system restart init quit) (setf *compile-verbose* *verbose* c::*suppress-compiler-warnings* (not *verbose*) c::*suppress-compiler-notes* (not *verbose*)) (let* ((cl-launch-objects (let* ((*features* (remove :cl-launch *features*)) (header (or *compile-file-pathname* *load-pathname* (getenv "CL_LAUNCH_HEADER"))) (header-file (ensure-lisp-file header "header.lisp")) (object (compile-file-pathname* header-file :system-p t))) (compile-file header-file :output-file object :system-p t) (list object))) (file-objects (when load (list (compile-and-load-file (ensure-lisp-file load "load.lisp") :verbose *verbose* :system-p t :load t)))) (system-objects (when system (let* ((target (find-system system)) (build (make-instance 'asdf::program-op))) (asdf:perform build target) (asdf:input-files build target)))) (standalone (getenv "CL_LAUNCH_STANDALONE")) (init-code `(setf *load-verbose* nil *dumped* ,(if standalone :standalone :wrapped) *arguments* nil ,@(when restart `(*restart* (read-function ,restart))) ,@(when init `(*init-forms* ,init)) ,@(unless quit `(*quit* nil)))) (epilogue-code `(progn ,init-code ,(if standalone '(resume) '(si::top-level)))) (fasl (c::builder :program (parse-namestring dump) :lisp-files (append cl-launch-objects file-objects system-objects) :epilogue-code epilogue-code))) (cleanup-temporary-files) (quit))) ;;; Attempt at compiling directly with asdf-ecl's make-build and temporary wrapper asd's ;;; Fails with weird linking errors. #+ecl (defvar *in-compile* nil) #+ecl (defun yyy-build-and-dump (dump load system restart init quit) (unwind-protect (let* ((*compile-verbose* *verbose*) (*in-compile* t) (c::*suppress-compiler-warnings* (not *verbose*)) (c::*suppress-compiler-notes* (not *verbose*)) (*features* (remove :cl-launch *features*)) (header (or *compile-file-pathname* *load-pathname* (getenv "CL_LAUNCH_HEADER"))) (header-file (ensure-lisp-file header "header.lisp")) (load-file (when load (ensure-lisp-file load "load.lisp"))) (standalone (getenv "CL_LAUNCH_STANDALONE")) (init-code `(unless *in-compile* (setf *load-verbose* nil *dumped* ,(if standalone :standalone :wrapped) *arguments* nil ,@(when restart `(*restart* (read-function ,restart))) ,@(when init `(*init-forms* ,init)) ,@(unless quit `(*quit* nil))) ,(if standalone '(resume) '(si::top-level)))) (init-file (temporary-file-from-sexp init-code "init.lisp")) (prefix-sys (temporary-filename "prefix")) (program-sys (temporary-filename "program")) (prefix-sysdef `(asdf:defsystem ,prefix-sys :depends-on () :serial t :components ((:file "header" :pathname ,header-file) ,@(when load-file `((:file "load" :pathname ,load-file)))))) (program-sysdef `(asdf:defsystem ,program-sys :depends-on (,prefix-sys ,@(when system `(,system))) :components ((:file "init" :pathname ,init-file)))) (prefix-asd (temporary-file-from-sexp prefix-sysdef "prefix.asd")) (program-asd (temporary-file-from-sexp program-sysdef "program.asd"))) (load prefix-asd) (load program-asd) (asdf::make-build program-sys :type :program) (si:system (format nil "cp -p ~S ~S" (namestring (first (asdf:output-files (make-instance 'asdf::program-op) (find-system program-sys)))) dump))) (cleanup-temporary-files)) (quit)) ;;;; Find a unique directory name for current implementation for the fasl cache ;;; (modified from SLIME's swank-loader.lisp) (defparameter *implementation-features* '(:allegro :lispworks :sbcl :clozure :cmu :clisp :ccl :corman :cormanlisp :armedbear :gcl :ecl :scl)) (defparameter *os-features* '(:macosx :linux :windows :mswindows :win32 :solaris :darwin :sunos :hpux :unix)) (defparameter *architecture-features* '(:powerpc :ppc :x86-64 :amd64 :x86 :i686 :i586 :i486 :pc386 :iapx386 :pentium3 :sparc64 :sparc :hppa64 :hppa)) (defun lisp-version-string () #+(or cmu scl sbcl ecl lispworks armedbear cormanlisp) (lisp-implementation-version) #+clozure (format nil "~d.~d.fasl~d" ccl::*openmcl-major-version* ccl::*openmcl-minor-version* (logand ccl::fasl-version #xFF)) #+allegro (format nil "~A~A~A" excl::*common-lisp-version-number* (if (eq 'h 'H) "A" "M") ; ANSI vs MoDeRn (if (member :64bit *features*) "-64bit" "")) #+clisp (let ((s (lisp-implementation-version))) (subseq s 0 (position #\space s))) #+gcl (let ((s (lisp-implementation-version))) (subseq s 4))) (defun ensure-directory-name (dn) (if (eql #\/ (char dn (1- (length dn)))) dn (concatenate 'string dn "/"))) (defun dirname->pathname (dn) (parse-namestring (ensure-directory-name dn))) (defun unique-directory-name (&optional warn) "Return a name that can be used as a directory name that is unique to a Lisp implementation, Lisp implementation version, operating system, and hardware architecture." (flet ((first-of (features) (find-if #'(lambda (f) (find f *features*)) features)) (maybe-warn (value fstring &rest args) (cond (value) (t (when warn (apply #'warn fstring args)) "unknown")))) (let ((lisp (maybe-warn (first-of *implementation-features*) "No implementation feature found in ~a." *implementation-features*)) (os (maybe-warn (first-of *os-features*) "No os feature found in ~a." *os-features*)) (arch (maybe-warn (first-of *architecture-features*) "No architecture feature found in ~a." *architecture-features*)) (version (maybe-warn (lisp-version-string) "Don't know how to get Lisp ~ implementation version."))) (substitute-if #\_ (lambda (x) (find x " /:\\(){}[]$#`'\"")) (format nil "~(~@{~a~^-~}~)" lisp version os arch))))) ;;;; Redefine the ASDF output-files method to put fasl's under the fasl cache. ;;; (taken from common-lisp-controller's post-sysdef-install.lisp) ;;#-common-lisp-controller (progn ; BEGIN of progn to disable caching when clc is detected (defparameter *wild-path* (make-pathname :directory '(:relative :wild-inferiors) :name :wild :type :wild :version nil)) (defun wilden (path) (merge-pathnames *wild-path* path)) #-asdf (defun resolve-symlinks (x) #+allegro (excl:pathname-resolve-symbolic-links x) #+gcl-pre2.7 x #-(or allegro gcl-pre2.7) (truename x)) (defvar *output-pathname-translations* nil "a list of pathname translations, where every translation is a list of a source pathname and destination pathname.") (defun exclude-from-cache (&rest dirs) (dolist (dir dirs) (when dir (let* ((p (if (pathnamep dir) dir (dirname->pathname dir))) (n #+asdf (resolve-symlinks p) #-asdf p) (w (wilden n))) (pushnew (list w w) cl-launch::*output-pathname-translations* :test #'equal))))) (defun calculate-output-pathname-translations () (setf *output-pathname-translations* `(#+(and common-lisp-controller (not gcl)) ,@(progn (ensure-directories-exist (calculate-fasl-root)) (let* ((sr (resolve-symlinks *source-root*)) (fr (resolve-symlinks *fasl-root*)) (sp (wilden sr)) (fp (wilden fr))) `((,sp ,fp) (,fp ,fp) ,@(when *redirect-fasl-files-to-cache* `((,(wilden "/") ,(wilden (merge-pathnames (make-pathname :directory '(:relative "local")) fr)))))))) #-(and common-lisp-controller (not gcl)) ,@(when (and *lisp-fasl-root* (not (eq *lisp-fasl-root* :disabled))) `((,(wilden "/") ,(wilden *lisp-fasl-root*)))))) ;; Do not recompile in private cache system-installed sources ;; that already have their accompanying precompiled fasls. #+(or clisp sbcl cmucl gcl) ; no need for ECL: no source/fasl couples there. (exclude-from-cache #p"/usr/lib/" #+clisp ext:*lib-directory* #+gcl system::*lib-directory* #+ecl c::*ecl-library-directory* #+sbcl (getenv "SBCL_HOME") #+cmu (truename #p"library:"))) (defun apply-pathname-translations (path &optional (translations *output-pathname-translations*)) #+gcl-pre2.7 path ;;; gcl 2.6 lacks pathname-match-p, anyway #-gcl-pre2.7 (loop for (source destination) in translations when (pathname-match-p path source) do (return (translate-pathname path source destination)) finally (return path))) #+asdf (handler-bind ((warning #'muffle-warning)) (defmethod asdf:output-files :around ((op asdf:operation) (c asdf:component)) "Method to rewrite output files to fasl-path" (let ((orig (call-next-method))) (mapcar #'apply-pathname-translations orig)))) ;; We provide cl-launch, no need to go looking for it further! #+asdf (unless (find-system :cl-launch nil) (asdf:defsystem :cl-launch #+gcl :pathname #+gcl "/dev/null" :depends-on () :serial t :components ())) ;);;END of progn to disable caching when clc is detected #| #+common-lisp-controller (defun beneath-clc-source-root? (pn) "Returns T if pn's directory below *source-root*" (when pn (let ((root-dir (pathname-directory (resolve-symlinks *source-root*))) (comp-dir (pathname-directory pn))) (and (>= (length comp-dir) (length root-dir)) (equalp root-dir (subseq comp-dir 0 (length root-dir))))))) |# (defun apply-output-pathname-translations (path) #| #+common-lisp-controller (progn (if (beneath-clc-source-root? path) (source-root-path-to-fasl-path path) (alternative-root-path-to-fasl-path path))) #-common-lisp-controller |# (apply-pathname-translations path)) #+asdf (defun load-system (system &key verbose) (asdf:oos 'asdf:load-op system :verbose verbose)) #+asdf (defun load-systems (&rest systems) (dolist (s systems) (load-system s :verbose *verbose*))) (defun file-newer-p (new-file old-file) "Returns true if NEW-FILE is strictly newer than OLD-FILE." (> (file-write-date new-file) (file-write-date old-file))) (defun compile-file-pathname* (source &rest args) #-gcl (apply-output-pathname-translations (apply #'compile-file-pathname source args)) #+gcl (let* ((system-p (getf args :system-p)) (args (loop for (x y . z) on args by #'cddr nconc (unless (eq x :system-p) (list x y)))) (path (apply-output-pathname-translations (apply #'compile-file-pathname source args)))) (if system-p (make-pathname :type "o" :defaults path) path))) #-(or cormanlisp) (defun compile-and-load-file (source &key force-recompile (verbose *verbose*) (load t) #+(or gcl ecl) system-p) "compiles and load specified SOURCE file, if either required by keyword argument FORCE-RECOMPILE, or not yet existing, or not up-to-date. Keyword argument VERBOSE specifies whether to be verbose. Returns two values: the fasl path, and T if the file was (re)compiled" ;; When in doubt, don't trust - recompile. Indeed, there are ;; edge cases cases when on the first time of compiling a simple ;; auto-generated file (e.g. from the automated test suite), the ;; fasl ends up being written to disk within the same second as the ;; source was produced, which cannot be distinguished from the ;; reverse case where the source code was produced in the same split ;; second as the previous version was done compiling. Could be ;; tricky if a big system needs be recompiled as a dependency on an ;; automatically generated file, but for cl-launch those ;; dependencies are not detected anyway (BAD). If/when they are, and ;; lacking better timestamps than the filesystem provides, you ;; should sleep after you generate your source code. ;; ;; Note: we don't seem to be using system-p for GCL, because it can dump core. #+(and gcl (not gcl-pre2.7)) (setf source (ensure-lisp-file-name source (concatenate 'string (pathname-name source) ".lisp"))) (let* ((truesource (truename source)) (fasl (compile-file-pathname* truesource #+(or gcl ecl) #+(or gcl ecl) :system-p system-p)) (compiled-p (when (or force-recompile (not (probe-file fasl)) (not (file-newer-p fasl source))) (ensure-directories-exist fasl) (multiple-value-bind (path warnings failures) (compile-file truesource :output-file fasl #+(or gcl ecl) #+(or gcl ecl) :system-p system-p #-gcl-pre2.7 #-gcl-pre2.7 #-gcl-pre2.7 #-gcl-pre2.7 :print verbose :verbose verbose) (declare (ignore warnings)) (unless (equal (truename fasl) (truename path)) (error "CL-Launch: file compiled to ~A, expected ~A" path fasl)) (when failures (error "CL-Launch: failures while compiling ~A" source))) t))) (when load #+(or gcl ecl) (when system-p (return-from compile-and-load-file (values fasl (or compiled-p (nth-value 1 (compile-and-load-file source :force-recompile force-recompile :verbose verbose :load t)))))) (load fasl :verbose verbose)) (values fasl compiled-p))) #+(or cormanlisp) (defun compile-and-load-file (source &key force-recompile verbose load) "Corman Lisp has trouble with compiled files (says SLIME)." (declare (ignore force-recompile)) (when load (load source :verbose verbose)) (force-output) (values nil t)) (defun load-file (source) #-(or gcl-pre2.7 (and ecl (not dlopen))) (compile-and-load-file source :verbose *verbose*) #+gcl-pre2.7 (let* ((pn (parse-namestring source))) ; when compiling, gcl 2.6 will always (if (pathname-type pn) ; add a type .lsp if type is missing, so avoid compilation (compile-and-load-file source :verbose *verbose*) (load source :verbose *verbose*))) #+(and ecl (not dlopen)) (load source :verbose *verbose*))) ;;#+ecl (progn (trace c::builder c::build-fasl c:build-static-library c:build-program compile-file compile-and-load-file compile-file-pathname* ensure-lisp-file-name ensure-lisp-file cleanup-temporary-files load) (setf c::*compiler-break-enable t *verbose* t)) NIL #| } print_lisp_code_bottom () { # |# ":" ; cat<<'NIL' ;;; END OF CL-LAUNCH LISP HEADER NIL #| } ### There we are. Now do the job [ $# -gt 0 ] || mini_help_abort all "$@" ; exit # |# ; What follows is Lisp code available when loading this file