* configure.ac.pamphlet (axiom_optimize_options): New substitued

	variable. 
	Genrate src/lisp/core.lisp at configure time.
	* configure.ac: Regenerate.
	* configure: Likewise.
	* config/setup-dep.mk ($(top_builddir)/src/lisp/core.lisp): New rule.

src/lisp/

	* Makefile.pamphlet (fasl_ext): New.  Factor out the logic
	for computing file extensions.
	(FASLS): Rename from CORE.  Use it to compute the list of files to
	load. 
	($(OUT)/lisp$(EXEEXT)): Adjust.
	(base-lisp$(EXEEXT)): sb-cltl2 module is no longer need.
	(core.lisp): Now depend on core.lisp.in.  Regenerate if necessary.
	(mostlyclean-local): Remove FASLs too.
	* Makefile.in: Regenerate.
	* core.lisp.in: New.
	* core.lisp.pamphlet: Move content to core.lisp.in.  Remove.

1 files changed, 743 insertions, 0 deletions

diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
new file mode 100644
index 00000000..8722220c
--- /dev/null
+++ b/src/lisp/core.lisp.in
@@ -0,0 +1,743 @@
+;; Ô Emacs, this is a -*- Lisp -*- file, despite apperance
+;; 
+;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; All rights reserved.
+;; 
+;; Copyright (C) 2007, Gabriel Dos Reis.
+;; All rights reserved.
+;;
+;; Redistribution and use in source and binary forms, with or without
+;; modification, are permitted provided that the following conditions are
+;; met:
+;;
+;;     - Redistributions of source code must retain the above copyright
+;;       notice, this list of conditions and the following disclaimer.
+;;
+;;     - Redistributions in binary form must reproduce the above copyright
+;;       notice, this list of conditions and the following disclaimer in
+;;       the documentation and/or other materials provided with the
+;;       distribution.
+;;
+;;     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;;       names of its contributors may be used to endorse or promote products
+;;       derived from this software without specific prior written permission.
+;;
+;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+;; 
+;; -*- Abstract -*-
+;; 
+;;  This pamphlet defines the core of the system utilities for building
+;;  Boot and Axiom executable.  It essentially etablishes a namespace
+;;  (package AxiomCore) and defines some macros and functions
+;;  that need to be present during during compilation and executable
+;;  image construction.
+;; 
+
+
+(defpackage "AxiomCore"
+  #+:common-lisp (:use "COMMON-LISP")
+  #-:common-lisp (:use "SYSTEM" "LISP" "USER")
+  ;; For GCL we need to explicitly use the DEFPACKAGE, otherwise the
+  ;; image obtained from compiler link will not work.  The root cause
+  ;; is a non-ANSI compliant organization of GCL's implementation.
+  #+:gcl (:use "DEFPACKAGE")
+  (:export "quit"
+           "fatalError"
+           "internalError"
+           "error"
+           "errorCount"
+           "countError"
+           "warn"
+           
+           "%hasFeature"
+	   
+	   "$hostPlatform"
+	   "$buildPlatform"
+	   "$targetPlatform"
+
+           "getCommandLineArguments"
+           "processCommandLine"
+           "handleCommandLine"
+           "$originalLispTopLevel"
+           "link"
+           "installDriver"
+           "associateRequestWithFileType"
+           "ensureTrailingSlash"
+           "getOutputPathname"
+           "loadPathname"
+           "compileLispFile"
+           "compileLispHandler"
+           "Option"
+
+           "IMPORT-MODULE"
+           ))
+
+(in-package "AxiomCore")
+
+;; 
+;; -*- Configuration Constants -*-
+;; 
+
+;; The canonical triplets for host, build, and target.   For the moment,
+;; they are all identical, for we don't support cross compilation yet.
+(defconstant |$hostPlatform| "@host@")
+(defconstant |$buildPlatform| "@build@")
+(defconstant |$targetPlatform| "@target@")
+
+;; Lisp compiler optimization settings.
+(proclaim '(optimize @axiom_optimize_options@))
+
+;; 
+;; -*- Hosting Lisp System -*-
+;; 
+
+;; The top level read-eval-print loop function of the base
+;; Lisp system we are using.  This is a very brittle way
+;; of achieving something conceptually simple.  
+(defconstant |$originalLispTopLevel|
+  #+:ecl #'si::top-level
+  #+:gcl #'si::top-level
+  #+:sbcl #'sb-impl::toplevel-init
+  #+clisp #'system::main-loop)
+
+;; Lisp source file extension.
+(defconstant |$LispFileType| "lisp")
+
+;; Extenstion of FASL files.
+(defconstant |$faslType|
+  (pathname-type (compile-file-pathname "foo.lisp")))
+
+;; 
+;; -*- OpenAxiom source file extensions -*-
+;; 
+
+(defconstant |$BootFileType| "boot")
+(defconstant |$LibraryFileType| "spad")
+(defconstant |$ScriptFileType| "input")
+
+;; Canonalize source file extensions
+(defun |getFileType|(file)
+  (let ((file-type (pathname-type file)))
+    (cond ((or (equal "clisp" file-type)
+               (equal "lsp" file-type))
+           |$LispFileType|)
+          (t file-type))))
+
+
+;; 
+;; -*- OpenAxiom Driver Table -*-
+;; 
+
+;; Global map from requests  to drivers.
+;; Ideally we want to handle
+;;    --help: just print a help menu and exit
+;;    --version: Print version information and exit
+;;    --compile: boot or lisp files
+;;    --translate: boot files
+;;    --make: boot, lisp, or fasl files
+(defparameter |$driverTable| (make-hash-table :test #'equal :size 5))
+
+
+;; Look up the driver that can handle REQUEST.  Returns nil when
+;; no driver exists.
+(defun |getDriver| (request)
+  (gethash request |$driverTable|))
+
+;; Associate DRIVER with REQUEST.
+(defun |installDriver| (request driver)
+  (when (|getDriver| request) 
+    (|internalError| "attempt to override driver"))
+  (setf (gethash request |$driverTable|) driver))
+
+;; Register DRIVER for a REQUEST for a file with FILE-TYPE extension.
+(defun |associateRequestWithFileType| (request file-type driver)
+  ;; If a driver is already installed, it must be non-null. 
+  ;; We don't allow overriding at the moment.
+  (let ((key (cons request file-type)))
+    (unless (|useFileType?| request)
+      (setf (get request 'use-file-type) t))
+    (|installDriver| key driver)))
+
+
+;; 
+;; -*- OpenAxiom Command Line Parsing -*-
+;; 
+
+;; Return a symbol object represensing option named OPT, without leading
+;; double dash (--).
+(defun |Option| (opt)
+  (intern opt (find-package "AxiomCore")))
+
+;; Returns a pair (name . value) if OPTION if of the form "--name=value",
+;; where name is a symbol and value is a string.  Otherwise, if
+;; OPTION is of the form "--name", returns the symbol name.
+(defun |parseOption| (option)
+  (setq option (subseq option 2))
+  (let ((p (position #\= option)))
+    (if p
+        (cons (|Option| (subseq option 0 p)) (subseq option (1+ p)))
+      (|Option| option))))
+
+;; Returns the value specified for OPTION. Otherwise, return nil
+(defun |getOptionValue| (opt options)
+  (let ((val (assoc opt options)))
+    (cond (val (cdr val))
+          (t nil))))
+
+;; Walk through the command line arguments ARGV, separating options
+;; of the form --opt or --opt=val into an a-list, and the rest
+;; of the command line into a list.  The processing stop as soon as
+;; a non-option form is encountered. OPTIONS-SO-FAR accumulates the
+;; the list of processed options.
+(defun |processCommandLine| (argv options-so-far)
+  (if (and argv
+           (equal "--" (subseq (car argv) 0 2)))
+      (let ((option (|parseOption| (car argv))))
+        (cond ((symbolp option)
+               (|processCommandLine| (cdr argv)
+                                     (cons (cons option t) options-so-far)))
+              ((consp option) 
+               (|processCommandLine| (cdr argv) (cons option options-so-far)))
+              (t (|internalError|
+                  (format nil "processCommandLine: unknown option ~S"
+                          option)))))
+    (values options-so-far argv)))
+
+
+;; 
+;; -*- Building New Lisp Images -*-
+;; 
+;; At many points, the build machinery makes new Lisp images that
+;; are the results of augmenting a given Lisp image with new 
+;; Lisp files (either compiled or in source form).  For most Lisp
+;; implementations, this is done by loading the Lisp files in the 
+;; current image and dumping the result on disk as an executable.
+
+
+(defun |getOutputPathname| (options &optional (default-output "a.out"))
+  (let ((output-option (assoc (|Option| "output") options)))
+    (if output-option
+        ;; If an output file name was specified on the command line, it
+        ;; is so relative to the current workding directory.  In 
+        ;; particular we want to prevent overly zelous SBCL to mess
+        ;; around with the output file when we call compile-file-pathname. 
+        ;; The SBCL-specific hack below does not work all the time, but in
+        ;; most cases, it is OK.
+        #+:sbcl (merge-pathnames (cdr output-option)
+                                 *default-pathname-defaults*)
+        #-:sbcl (cdr output-option)
+        default-output)))
+
+
+(defun |getMainEntryPoint| (options)
+  (|getOptionValue| (|Option| "main") options))
+
+;; Save current image on disk as executable and quit.
+(defun |saveCore| (core-image &optional (entry-point nil))
+  ;; When building the Axiom system, and in many other cases I suspect,
+  ;; the main entry point is some function in a package not known to
+  ;; the Lisp system at compile time, so we have delayed the 
+  ;; evaluation of the entry point in a form of a suspension.  At this
+  ;; point we must have all data needed to complete the evaluation.
+  (when (consp entry-point)
+    (setq entry-point (apply (car entry-point) 
+                             (cdr entry-point))))
+  #+:sbcl (if (null entry-point)
+              (sb-ext::save-lisp-and-die core-image :executable t)
+            (sb-ext::save-lisp-and-die core-image 
+                                       :toplevel entry-point
+                                       :executable t))
+  #+:gcl (progn 
+           (when entry-point 
+             (setq si::*top-level-hook* entry-point))
+           (system::save-system core-image))
+  #+:clisp (progn 
+             (if entry-point
+                 (ext::saveinitmem core-image 
+                                   :init-function entry-point
+                                   :executable t
+                                   :norc t
+                                   )
+               (ext::saveinitmem core-image 
+                                 :executable t
+                                 :norc t
+                                 ))
+             (ext::quit))
+  (error "don't know how to save Lisp image"))
+
+
+;; 
+;; -*- Program Termination -*-
+;; 
+;; When working in batch mode, we need to return so-called `exit status'
+;; to the calling shell.  Common Lisp has no provision for that ---
+;; not even exiting from the toplevel read-eval-print loop.  Most
+;; Lisp implementations provide an `exit' function as extensions, though
+;; they don't agree on the exact spelling, therefore on the API.
+
+;; The function |quit| is our abstractions over those variabilties.
+;; It takes an optional small integer value, the exit status code to
+;; return to the calling shell.  When no exit status code is specified,
+;; it would return $0$, meaning that everything is OK.
+(defun |quit| (&optional (status 0))
+  #+:sbcl (sb-ext:quit :unix-status status)
+  #+:clisp (ext:quit status)
+  #+:gcl (si::bye status)
+  #+:ecl (ext:quit status)
+  #-(or :sbcl :clisp :gcl :ecl) 
+  (error "`quit' not implemented for this Lisp"))
+
+
+;; 
+;; -*- Basic Diagnostic Routines -*-
+;; 
+;;    For the most basic batch stuff, we want:
+;;       (1) fatal error: output message and exit with nonzero status
+;;       (2) internal error: same.  This is for use on reporting internal
+;;           consistency error.
+(defun |diagnosticMessage|(prefix msg)
+  (let ((text (concatenate 'string prefix ": " msg)))
+    (write-line text *error-output*)))
+
+;; Keep count of number of hard errors.
+(defparameter |$errorCount| 0)
+
+(defun |errorCount| nil
+  |$errorCount|)
+
+(defun |countError| nil
+  (setq |$errorCount| (1+ |$errorCount|)))
+
+(defun |fatalError| (msg)
+  (|countError|)
+  (|diagnosticMessage| "fatal error" msg)
+  (|quit| 1))
+
+(defun |internalError| (msg)
+  (|countError|)
+  (|diagnosticMessage| "internal error" msg)
+  (|quit| 1))
+
+(defun |error| (msg)
+  (|countError|)
+  (|diagnosticMessage| "error"
+   (cond ((consp msg) 
+          (reduce #'(lambda (x y)
+                      (concatenate 'string x y))
+                  msg :initial-value ""))
+         (t msg))))
+
+(defun |warn| (msg)
+  (|diagnosticMessage| "warning"
+   (cond ((consp msg) 
+          (reduce #'(lambda (x y)
+                      (concatenate 'string x y))
+                  msg :initial-value ""))
+         (t msg))))
+
+;; 
+;; -*- Command Line Arguments -*-
+;; 
+;; Ideally, we would just like to have a traditional command line
+;; passing mechanism from the shell to the application.  That 
+;; mechanism works fine with GCL.  Some Lisp implementations such as
+;; SBCL or CLISP will insist on processing the command lines.  Some
+;; such CLISP will barfle when they hit an option they don't 
+;; understand.  Which is silly.  It seems like the only common ground,
+;; as ever, is to go with the most annoying behaviour and penalize
+;; the good "citizen", sensible, Lisp implementations interfaces.
+;; Consequently, we have standardize on the the following practice:
+;; always issue a double bash (--) after the command line, and afterwards
+;; supply options and other arguments.  The double dash has the effect
+;; of disuading the underlying lisp implementation of trying to
+;; process whatever comes after as options.  
+
+;; Command line arguments: equivalent of traditional `argv[]' from
+;;  systems programming world.
+(defun |getCommandLineArguments| nil
+  #-(or :gcl :sbcl :clisp :ecl) 
+  (|fatalError| "don't know how to get command line args")
+  (let* ((all-args  
+          #+:ecl (ext:command-args)
+          #+:gcl si::*command-args*
+          #+:sbcl sb-ext::*posix-argv*
+          #+:clisp (coerce (ext::argv) 'list))
+         (args (member "--" all-args :test #'equal)))
+    (cons (car all-args) (if args (cdr args) args))))
+
+
+;; 
+;; -*- Program Startup -*-
+;; 
+
+;; The top level entry point to most saved Lisp image.
+(defun |main| nil
+  (setq *package* (find-package "BOOT"))
+  ;; Existing system programming practive, and POSIX, have it
+  ;; that the first argument on the command line is the name
+  ;; of the current instantiation of the program.
+  ;; We require at least two arguments:
+  ;;    (0) the program name
+  ;;    (1) either one of --help or --version, or
+  ;;        a filename.
+  (let ((command-args (|getCommandLineArguments|)))
+    (when (null command-args) 
+      (|internalError| "empty command line args"))
+    (when (fboundp '|main|)
+      (|quit| (funcall '|main| command-args)))
+
+    ;; Huh, the main entry point was not defined.
+    (|fatalError| "missing definition for main function")
+    (|quit| 1)))
+
+
+;; 
+;; -*- Building Standalone Executable -*-
+;; 
+;; Build a standalone excutable from LISP-FILES -- a list of
+;; pathnames designating compiled source files (either FASLs, for
+;; most Lisp systems, or object files for systems like ECL.)
+;; ENTRY-POINT is the entry point of the program.  If not supplied, or
+;; if null, then the entry entry is supposed to be the top level
+;; read-eval-print loop of original Lisp system.
+(defun |link| (core-image lisp-files &optional (entry-point nil))
+  (if (and entry-point (stringp entry-point))
+      (setq entry-point `(read-from-string ,entry-point)))
+  #-:ecl (progn
+           (mapcar #'(lambda (p) (|loadOrElse| p)) lisp-files)
+           (|saveCore| core-image entry-point))
+  #+:ecl (progn
+           (unless entry-point
+             (setq entry-point si::top-level))
+           (c:build-program core-image 
+                            :lisp-files lisp-files
+                            :epilogue-code `(funcall ,entry-point))
+           (|quit|)))
+
+
+;; 
+;; -*- Handling Command Line Arguments -*-
+;; 
+
+(defun |handleRequest| (prog-name request options args)
+  (let ((driver (|getDriver| request)))
+    (when (null driver) 
+      (|fatalError| (format nil "invalid option ~S" request)))
+    (funcall driver prog-name options args)))
+
+(defun |hasHandler?| (request)
+  (|getDriver| request))
+
+(defun |useFileType?| (request)
+  (get request 'use-file-type))
+
+(defun |handleCommandLine| (prog-name options args)
+  ;; If no argument was specified on command line, then pretend
+  ;; we must act as the underlying Lisp system's REPL.  This is hard
+  ;; to do portabl and correctly, for obvious reasons  So what follows
+  ;; is an approximation, good enough for now.  FIXME: revisit this
+  ;; gorss hack.
+  (unless (or options args)
+    ;; GCL called us through system::*top-level-hook* which we set
+    ;; in a previous life.  Now unset it, otherwise, it will call
+    ;; us again, and we will find ourselves in the same place
+    ;; again, again, until death follows.
+    #+:gcl (setq system::*top-level-hook* nil)
+    (funcall |$originalLispTopLevel|))
+
+  (dolist (opt options)
+    (cond ((eq (car opt) (|Option| "help")) ; print help, get out of here
+           (|helpHandler| prog-name))
+        
+          ((null args)                 ; we must have at least one arg
+           (|printUsage| prog-name)
+           (|quit| 1))
+        
+          ((|useFileType?| (car opt))   ; process based on file type
+           (dolist (f args)
+             (let* ((file-type (|getFileType| f))
+                    (opt-name (car opt))
+                    (request (cons opt-name file-type)))
+               (|handleRequest| prog-name request options f))))
+
+          ((stringp (cdr opt))          ; option value
+           (when (|hasHandler?| (car opt))
+             (|handleRequest| prog-name (car opt) options args)))
+          
+          (t                            ; assume we must execute this
+           (|handleRequest| prog-name (car opt) options args)))))
+
+
+
+;; 
+;; -*- --help Handler -*-
+;; 
+
+;; Print help screen
+(defun |printUsage|(prog-name)
+  (write-line "usage:")
+  (write-line 
+   (concatenate 'string prog-name " -- options [files]"))
+  (write-line "option:")
+  (write-line "   --help                 print this message")
+  (write-line "   --compile              compile file")
+  (write-line "   --output=OUT           set output file to OUT")
+  (write-line "   --load-directory=DIR   use DIR as search path for modules")
+  (write-line "   --make                 create an executable"))
+
+(defun |helpHandler|(prog-name)
+  (|printUsage| prog-name)
+  (|quit|))
+
+(|installDriver| (|Option| "help") #'|helpHandler|)
+
+
+;; 
+;; -*- --make Handler -*-
+;; 
+
+(defun |makeHandler| (prog-name options args)
+  (declare (ignore prog-name))
+  (unless (> (length args) 0)
+    (|fatalError| "--make requires at least one file"))
+
+  (|link| (|getOutputPathname| options) args (|getMainEntryPoint| options))
+  (|quit|))
+
+(|installDriver| (|Option| "make") #'|makeHandler|)
+
+
+;; 
+;; -*- --load-directory Handler -*-
+;; 
+
+;; Remember value specified for the --load-dircetory option.  Notice
+;; that this is the direct handler for that option.  Consequently, it
+;; passed all three arguments: PROG-NAME OPTIONS ARGS.  Only the second
+;; argument is of interest.
+(defun |recordLoadDirectory| (prog-name options args)
+  (declare (ignore prog-name args)
+           (special |$LoadDirectories|))
+  (let ((load-option (assoc (|Option| "load-directory") options)))
+    (unless load-option
+      (|internalError| "`recordLoadDirectory' called without option"))
+    (unless (cdr load-option)
+      (|fatalError| "--load-directory option without value"))
+    (pushnew (cdr load-option) |$LoadDirectories| :test #'equal)
+    ))
+
+(|installDriver| (|Option| "load-directory")  #'|recordLoadDirectory|)
+
+;; 
+;; -*- --compile Handler for Lisp Source Files -*-
+;; 
+(declaim (inline |compileFilePathname|))
+(defun |compileFilePathname| (file)
+  #-:ecl (compile-file-pathname file)
+  #+:ecl (compile-file-pathname file :type :object))
+
+(defun |currentDirectoryName| nil
+  (let* ((dir (namestring (truename "")))
+         (n (1- (length dir))))
+    (if (char= (char dir n) #\/)
+        (subseq dir 0 n)
+      dir)))    
+
+;; Compile Lisp source files to target object code.  Most of the time
+;; this function is called externally to accomplish just that: compile
+;; a Lisp file.  So, by default, we exit the read-eval-print loop after
+;; the task is done.
+;; 
+;; NOTE: The Lisp system ECL has an interesting compilation and program
+;; build model.  It distinguishes between FASL files (results of 
+;; compilation usable as operand to LOAD) and object files (result of
+;; compilation usable to build standalone programs).  We are primarily
+;; interested in producing compiled files that can be used to produce
+;; standalone programs.  Consequently we must convince ECL to produce
+;; object files.  Notice that when program components require that
+;; previously compiled files be loaded in the startup environment, 
+;; the system will load the FASL file.  So, we end up compiling
+;; twice: once as object code, once as FASL.  That is surely wrong.  There
+;; me be ways to build one from the one with less work.
+(defun |compileLispFile| (file out-file)
+  ;; When OUT-FILE does not have a specified parent directory, it is
+  ;; implied that the compiled file is placed in the current directory.
+  ;; This is a very common convention on traditional systems and
+  ;; environments.  However GCL would insist to pick the parent
+  ;; directory from FILE, which clearly is bogus.  
+  ;; Consequently, we must convince GCL to do what we expected.
+  #+gcl (when (and (pathname-directory file)
+                   (not (pathname-directory out-file)))
+          (setq out-file 
+                (make-pathname :name (pathname-name out-file)
+                               :type (pathname-type out-file)
+                               :directory (list (|currentDirectoryName|)))))
+
+  (multiple-value-bind (result warning-p failure-p) 
+                       #-:ecl (compile-file file :output-file out-file)
+                       #+:ecl (multiple-value-prog1
+                               (compile-file file 
+                                             :output-file out-file 
+                                             :system-p t)
+                               (c::build-fasl 
+                                (compile-file-pathname out-file)
+                                :lisp-files `(,out-file)))
+                       (unless result
+                         (|error| "compilation of Lisp code failed"))
+                       (cond ((and failure-p)
+                              ;; Since we believe the source code must
+                              ;; be fixed, we don't want to leave
+                              ;; the generated FASL behing us, as that
+                              ;; would confuse both user and tools.
+                              (delete-file result)
+                              (|error| "Lisp code contained errors"))
+
+                             (warning-p
+                              (|warn| "Lisp code contained warnings")))
+                       result))
+
+(defun |compileLispHandler| (prog-name options file)
+  (declare (ignore prog-name))
+  (let ((out-file (|getOutputPathname| options 
+                                       (|compileFilePathname| file))))
+    (|compileLispFile| file out-file)))
+
+(|associateRequestWithFileType| (|Option| "compile") |$LispFileType|
+ #'|compileLispHandler|)
+
+
+;; 
+;; -*- Predefined System Entry Point -*-
+;; 
+
+;; The top level entry point to most saved Lisp image.
+(defun |topLevel|()
+  (setq *package* (find-package "AxiomCore"))
+  (let ((command-args (|getCommandLineArguments|)))
+    (when (null command-args) 
+      (|internalError| "empty command line args"))
+    ;; Existing system programming practive, and POSIX, have it
+    ;; that the first argument on the command line is the name
+    ;; of the current instantiation of the program.
+    ;; We require at least two arguments:
+    ;;    (0) the program name
+    ;;    (1) either one of --help or --version, or
+    ;;        a filename.
+    (multiple-value-bind 
+     (options args) (|processCommandLine| (cdr command-args) nil)
+                        
+     ;; Push into the system's preferred namespace.  Ideally, this should
+     ;; be run of initialization code if needed.  However, a curiously
+     ;; nasty bug in GCL prevents us from expressing the natural semantics
+     ;; in a clean way.
+     (when (boundp '|$sysScope|)
+       (setq *package* (find-package (symbol-value '|$sysScope|))))
+     
+     (|handleCommandLine| (car command-args) options args)
+     (|quit| (if (> (|errorCount|) 0) 1 0)))))
+
+
+;; 
+;; -*- Filesystem Utilities -*-
+;; 
+
+;; Make sure that directory name DIR ends with a slash.
+(defun |ensureTrailingSlash| (dir)
+  (let ((l (length dir)))
+    (unless (> l 0)
+      (|fatalError| "null directory name"))
+    (if (char= (char dir (- l 1)) #\/)
+        dir
+      (concatenate 'string dir "/"))))
+
+
+;; 
+;; -*- Modules in OpenAxiom -*-
+;; 
+
+;; List of directories to search for FASLs.
+(defparameter |$LoadDirectories| nil)
+;; List of FASLs imported
+
+(defparameter |$ImportedModules| nil)
+;; Return true if MODULE is known to have been imported or loaded.
+
+(defun |alreadyLoaded?| (module)
+  (member (namestring module) |$ImportedModules| :test #'equal))
+
+;; Remember that MODULE is imported or loaded.
+(defun |noteLoadUnit| (module)
+  (pushnew (namestring module) |$ImportedModules|))
+
+;; We are searching for MODULE (currently a FASL) in DIRECTORY.  So, this
+;; function returns a (tentative) pathname designating that module.
+(defun |loadPathname| (module dir)
+  (setq dir (|ensureTrailingSlash| dir))
+  (make-pathname :directory (pathname-directory dir)
+                 :name module
+                 #-:ecl :type #-:ecl |$faslType|))
+
+(defun |loadIfPresent| (module)
+  (if (|alreadyLoaded?| module)
+      module
+    (when (load module :if-does-not-exist nil)
+      (|noteLoadUnit| module)
+      module)))
+
+(defun |loadOrElse| (module)
+  (if (|alreadyLoaded?| module)
+      module
+    (when (load module :if-does-not-exist :error)
+      (|noteLoadUnit| module)
+      module)))
+
+(defun do-import-module (module directories)
+  (unless directories
+    (|fatalError| 
+     (format nil 
+             "module ~S not found in search path ~S"
+             module 
+             |$LoadDirectories|)))
+  (let ((p (|loadPathname| module (car directories))))
+    (unless (|loadIfPresent| p)
+      (do-import-module module (cdr directories)))))
+
+(defun |importModule| (module)
+  (do-import-module module |$LoadDirectories|))
+
+(defmacro import-module (module)
+  `(progn (eval-when 
+           #+:common-lisp (:compile-toplevel :load-toplevel :execute)
+           #-:common-lisp (compile load eval)
+                     (|importModule| ,module))))
+
+
+;; 
+;; -*- Feature Tests in Boot -*-
+;; 
+
+(defun |%hasFeature| (f)
+  (member f *features* :test #'eq))
+
+;; -*- Lisp Implementatiom-dependen Supports -*-
+
+#+ :sbcl
+(defun shoe-provide-module(name)
+  (load name)
+  (provide name))
+
+#+ :sbcl
+(eval-when (:load-toplevel :execute)
+   (pushnew #'shoe-provide-module sb-ext:*module-provider-functions*))