diff options
Diffstat (limited to 'src/lisp')
| -rw-r--r-- | src/lisp/ChangeLog | 157 | ||||
| -rw-r--r-- | src/lisp/Makefile.in | 75 | ||||
| -rw-r--r-- | src/lisp/Makefile.pamphlet | 113 | ||||
| -rw-r--r-- | src/lisp/core.lisp.pamphlet | 775 |
4 files changed, 1120 insertions, 0 deletions
diff --git a/src/lisp/ChangeLog b/src/lisp/ChangeLog new file mode 100644 index 00000000..7d5aa312 --- /dev/null +++ b/src/lisp/ChangeLog @@ -0,0 +1,157 @@ +2007-08-07 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * core.lisp.pamphlet (|topLevel|): Push into system's preferred + scope before handling command lines. + +2007-08-05 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * core.lisp.pamphlet: Tidy. + + * Makefile.pamphlet ($(OUT)/lisp$(EXEEXT)): Require base-lisp. Tidy. + (base-lisp$(EXEEXT)): New rule. + (core.lisp): Likewise. + (core.$(FASLEXT)): Likewise. + (all-ax all-lisp): Depend on stamp. + (stamp): New rule. + (mostlyclean-local): Tidy. + * Makefile.in: Regenerate. + +2007-07-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * core.lisp.pamphlet: New. + +2007-07-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet: Propagate libtoolization changes. + * Makefile.in: Regenerate. + +2007-06-25 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet ($(OUT)/lisp$(EXEXT)): Set the resumption + entry-point. + * Makefile.in: Regenerate. + +2007-03-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet ($(OUT)/lisp$(EXEEXT)): Dont' depend on + $(AXIOM_LISP). Load ../boot/initial-env.lisp before saving to + disk. Remove obsolete GCL build description. + (mostlyclean-local): Remove saved Lisp image. + * Makefile.in: Regenerate. + +2007-03-04 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet ($(OUT)/lisp$(EXEEXT)): Conditionally depend + on GCL. + * Makefile.in: Regenerate. + +2006-12-10 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet ($(OUT)/lisp$(EXEEXT)): Run GCL/rsym hack + work-around commands if necessary. + * Makefile.in: Regenerate. + +2006-12-09 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet ($(OUT)/lisp$(EXEEXT)): Add extra libraries if + necessary. + * Makefile.in: Regenerate. + +2006-12-06 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet ($(OUT)/lisp$(EXEEXT)): Build "lisp" image in + the build directory, then copy over to the destination dir. + * Makefile.in: Regenerate. + +2006-12-02 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet (lisp_c_objects): New variable. + ($(OUT)/lisp$(EXEEXT)): Use it. Don't include libspad.a. + * Makefile.in: Regenerate. + +2006-11-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet: Add support OSs that require file extension + for executable binaries. + * Makefile.in: Regenerate. + +2006-11-24 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet (<<gcl-2.6.8pre.socket.patch>>): Remove, as no + longer used. + (<<gcl-2.6.8pre.libspad.patch>>): Likewise. + (<<gcl-2.6.8pre.collectfn.fix>>): Likewise. + +2006-10-28 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet (mostlyclean-local): Don't remove GCL build + directory. + (clean-local): Do it. + +2006-10-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet ($(axiom_build_bindir)/gcl): Don't apply + toploop.patch anymore. + (<<gcl-2.6.8pre.toploop.patch>>): Remove. + * Makefile.in: Regenerate. + +2006-10-02 Waldek Hebisch <hebisch@math.uni.wroc.pl> + + * Makefile.pamphlet: Keep backlash newlines outside + of quotes. + * Makefile.in: Regenerate. + +2006-09-25 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet ($(GCLVERSION)): New rule. + ($(axiom_build_bindir)/gcl): Use it as prerequisite. + * Makefile.in: Regenerate. + +2006-09-18 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet: Use $(axiom_builddir) to store GCL image. + Leave obejcts files there. + ($(OUT)/lisp): Record dependencies. + (subdir): New. + (pamphlets): Likewise. + (lisp_DEPENDENCIES): Likewise. + (document): Remove. + (clean-local): Rename from clean. + (mostlyclean-local, distclean-local): New. + * Makefile.in: Regenerate. + +2006-09-17 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet: Build GCL from Axiom source as if we were + building for a system-wide installation. Don't apply custom + patches. Remove stamp-gcldir as target. Set GCLVERSION here. + * Makefile.in: Regenerate. + +2006-09-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet (${LSP}/ccl/Makefile): Remove. + (ccldir): Dependent on Makefile from builddir, not LSP. + * Makefile.in: Regenerate. + +2006-08-30 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet (<<gclConfigureMake>>=): Configure GCL with + --disable-xgcl. + * Makefile.in: Regenerate. + +2006-08-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet: Rework. Factorize stanzas. + (gcl-2.6.8predir): Rename from gcl-2.6.8pre. + (gcl-systemdir): Rename from gcl-system. + (stamp-gcldir): Rename from all. + * Makefile.in: Generate. + +2006-08-26 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet: Remove support for 2.6.7. + +2006-08-12 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * Makefile.pamphlet: Remove stanzas prior to gcl-2.6.7. + diff --git a/src/lisp/Makefile.in b/src/lisp/Makefile.in new file mode 100644 index 00000000..67f1d51a --- /dev/null +++ b/src/lisp/Makefile.in @@ -0,0 +1,75 @@ +OUT = $(axiom_build_bindir) + +subdir = src/lisp/ + +pamphlets = Makefile.pamphlet + +build_libdir = ./$(top_builddir)/src/lib + +lisp_DEPENDENCIES = $(build_libdir)/cfuns-c.lo \ + $(build_libdir)/sockio-c.lo \ + $(build_libdir)/libspad.la + +.PHONY: all all-lisp +all: all-ax all-lisp + +all-ax all-lisp: stamp + +stamp: $(OUT)/lisp$(EXEEXT) + @rm -f stamp + $(STAMP) $@ + +## Create a fresh image for building interpsys and AXIOMsys +## These objects files are the C runtime support +## and must be compiled into the Lisp image, +## as they must be present in the final interpreter +## and image. +lisp_c_objects = \ + $(build_libdir)/bsdsignal.lo \ + $(build_libdir)/cfuns-c.lo \ + $(build_libdir)/sockio-c.lo + +$(OUT)/lisp$(EXEEXT): base-lisp$(EXEEXT) +ifeq (@axiom_lisp_flavor@,gcl) + @axiom_gcl_rsym_hack@ + echo '(let ((compiler::*ld* "$(LINK) -o"))' \ + '(compiler::link (quote ("core.$(FASLEXT)")) "lisp$(EXEEXT)" ' \ + ' (format nil "(progn (let ((*load-path* (cons ~S *load-path*))'\ + ' (si::*load-types* ~S))' \ + ' (compiler::emit-fn t))' \ + ' (when (fboundp (quote si::sgc-on))' \ + ' (si::sgc-on t))' \ + ' (setq compiler::*default-system-p* t)' \ + ' (setq si::*top-level-hook* (read-from-string \"|AxiomCore|::|topLevel|\")))"' \ + ' si::*system-directory* (quote (list ".lsp")))' \ + ' "$(lisp_c_objects) @axiom_c_runtime_extra@"))' \ + | ./base-lisp$(EXEEXT) + $(INSTALL_PROGRAM) lisp$(EXEEXT) $(OUT) +endif + + +base-lisp$(EXEEXT): core.$(FASLEXT) + $(AXIOM_LISP) \ + $(eval_flags) '(progn #+:sbcl (require :sb-cltl2))' \ + $(eval_flags) '(load "$<")' \ + $(eval_flags) '(|AxiomCore|::|link| "$@" (quote nil) (function |AxiomCore|::|topLevel|))' + +core.lisp: $(srcdir)/core.lisp.pamphlet + $(axiom_build_document) --tangle --output=$@ $< + +core.$(FASLEXT): core.lisp + $(AXIOM_LISP) $(quiet_flags) \ + $(eval_flags) '(progn #+:sbcl (require :sb-cltl2))' \ + $(eval_flags) '(progn #-:ecl (compile-file "$<"))' \ + $(eval_flags) '(progn #+:ecl (progn (require (quote cmp)) (compile-file "$<" :system-p t) (c::build-fasl "$@" :lisp-files (quote ("core.$(OBJEXT)")))))' \ + $(eval_flags) '(quit)' + + +mostlyclean-local: + @rm -f $(OUT)/lisp$(EXEEXT) lisp$(EXEEXT) + @rm -f stamp + +clean-local: mostlyclean + +distclean-local: clean-local + @rm -f Makefile diff --git a/src/lisp/Makefile.pamphlet b/src/lisp/Makefile.pamphlet new file mode 100644 index 00000000..b252d4cd --- /dev/null +++ b/src/lisp/Makefile.pamphlet @@ -0,0 +1,113 @@ +%% Oh Emacs, this is a -*- Makefile -*-, so give me tabs. +\documentclass{article} +\usepackage{axiom} + +\title{\File{src/lisp/Makefile} Pamphlet} +\author{The Axiom Team} + +\begin{document} +\maketitle + +\begin{abstract} +\end{abstract} +\eject + +\tableofcontents +\eject + +\section{The Makefile} + +The purpose of this Makefile is to create a fresh Lisp image, [[$(OUT)/lisp]], +for use to make \Tool{interpsys} and \Tool{AXIOMsys}. To that end, +it augments an existing Lisp image, at the moment \Tool{GCL}, with +some specific C-routines. + +\section{The Makefile} + +<<build augmented lisp>>= +## Create a fresh image for building interpsys and AXIOMsys +## These objects files are the C runtime support +## and must be compiled into the Lisp image, +## as they must be present in the final interpreter +## and image. +lisp_c_objects = \ + $(build_libdir)/bsdsignal.lo \ + $(build_libdir)/cfuns-c.lo \ + $(build_libdir)/sockio-c.lo + +$(OUT)/lisp$(EXEEXT): base-lisp$(EXEEXT) +ifeq (@axiom_lisp_flavor@,gcl) + @axiom_gcl_rsym_hack@ + echo '(let ((compiler::*ld* "$(LINK) -o"))' \ + '(compiler::link (quote ("core.$(FASLEXT)")) "lisp$(EXEEXT)" ' \ + ' (format nil "(progn (let ((*load-path* (cons ~S *load-path*))'\ + ' (si::*load-types* ~S))' \ + ' (compiler::emit-fn t))' \ + ' (when (fboundp (quote si::sgc-on))' \ + ' (si::sgc-on t))' \ + ' (setq compiler::*default-system-p* t)' \ + ' (setq si::*top-level-hook* (read-from-string \"|AxiomCore|::|topLevel|\")))"' \ + ' si::*system-directory* (quote (list ".lsp")))' \ + ' "$(lisp_c_objects) @axiom_c_runtime_extra@"))' \ + | ./base-lisp$(EXEEXT) + $(INSTALL_PROGRAM) lisp$(EXEEXT) $(OUT) +endif + + +base-lisp$(EXEEXT): core.$(FASLEXT) + $(AXIOM_LISP) \ + $(eval_flags) '(progn #+:sbcl (require :sb-cltl2))' \ + $(eval_flags) '(load "$<")' \ + $(eval_flags) '(|AxiomCore|::|link| "$@" (quote nil) (function |AxiomCore|::|topLevel|))' + +core.lisp: $(srcdir)/core.lisp.pamphlet + $(axiom_build_document) --tangle --output=$@ $< + +core.$(FASLEXT): core.lisp + $(AXIOM_LISP) $(quiet_flags) \ + $(eval_flags) '(progn #+:sbcl (require :sb-cltl2))' \ + $(eval_flags) '(progn #-:ecl (compile-file "$<"))' \ + $(eval_flags) '(progn #+:ecl (progn (require (quote cmp)) (compile-file "$<" :system-p t) (c::build-fasl "$@" :lisp-files (quote ("core.$(OBJEXT)")))))' \ + $(eval_flags) '(quit)' + +@ + +<<*>>= +OUT = $(axiom_build_bindir) + +subdir = src/lisp/ + +pamphlets = Makefile.pamphlet + +build_libdir = ./$(top_builddir)/src/lib + +lisp_DEPENDENCIES = $(build_libdir)/cfuns-c.lo \ + $(build_libdir)/sockio-c.lo \ + $(build_libdir)/libspad.la + +.PHONY: all all-lisp +all: all-ax all-lisp + +all-ax all-lisp: stamp + +stamp: $(OUT)/lisp$(EXEEXT) + @rm -f stamp + $(STAMP) $@ + +<<build augmented lisp>> + +mostlyclean-local: + @rm -f $(OUT)/lisp$(EXEEXT) lisp$(EXEEXT) + @rm -f stamp + +clean-local: mostlyclean + +distclean-local: clean-local + @rm -f Makefile +@ + +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} diff --git a/src/lisp/core.lisp.pamphlet b/src/lisp/core.lisp.pamphlet new file mode 100644 index 00000000..8c06119d --- /dev/null +++ b/src/lisp/core.lisp.pamphlet @@ -0,0 +1,775 @@ +%% Oh Emacs, this is a -*- Lisp -*- file, despite apperance +\documentclass{article} +\usepackage{axiom} + +\title{\File{src/lisp/core.lisp} Pamphlet} +\author{Gabriel Dos~Reis} + +\begin{document} +\maketitle + +\begin{abstract} + This pamphlet defines the core of the system utilities for building + Boot and Axiom executable.. It essentially etablishes a namespace + (package \Code{AxiomCore}) and defines some macros and functions + that need to be present during during compilation and executable + image construction. +\end{abstract} + +\section{The [[AxiomCore]] package} + +<<AxiomCore>>= +(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" + "getCommandLineArguments" + "processCommandLine" + "handleCommandLine" + "$originalLispTopLevel" + "link" + "installDriver" + "associateRequestWithFileType" + "ensureTrailingSlash" + "getOutputPathname" + "loadPathname" + "compileLispFile" + "compileLispHandler" + "Option" + + "IMPORT-MODULE" + )) + +(in-package "AxiomCore") +@ + +\section{Base Lisp system top level entry point} + +<<AxiomCore>>= +;; 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) +@ + +\section{File types} + +<<AxiomCore>>= +(defconstant |$LispFileType| "lisp") +;; Extenstion of FASL files. +(defconstant |$faslType| + (pathname-type (compile-file-pathname "foo.lisp"))) +(defconstant |$BootFileType| "boot") +(defconstant |$LibraryFileType| "spad") +(defconstant |$ScriptFileType| "input") +@ + +\subsection{File type canonilization} + +<<AxiomCore>>= +(defun |getFileType|(file) + (let ((file-type (pathname-type file))) + (cond ((or (equal "clisp" file-type) + (equal "lsp" file-type)) + |$LispFileType|) + (t file-type)))) +@ + +\section{Drivers table} + +\subsection{The driver table} + +<<AxiomCore>>= +;; 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)) +@ + +\subsection{Obtaining a driver for a request} + +<<AxiomCore>>= +;; Look up the driver that can handle REQUEST. Returns nil when +;; no driver exists. +(defun |getDriver| (request) + (gethash request |$driverTable|)) +@ + +\subsection{Installing a driver for a request} + +<<AxiomCore>>= +(defun |installDriver| (request driver) + (when (|getDriver| request) + (|internalError| "attempt to override driver")) + (setf (gethash request |$driverTable|) driver)) +@ + +<<AxiomCore>>= +;; Register DRIVER for a REQUEST +(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))) +@ + + +\subsection{Making names for options} + +<<AxiomCore>>= +(defun |Option| (msg) + (intern msg (find-package "AxiomCore"))) +@ + +\subsection{Parsing command line options} + +<<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))) +@ + + +\section{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. + +\subsection{Pathname of output program} + +<<AxiomCore>>= +(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))) +@ + +\subsection{User-supplied main entry point} + +<<AxiomCore>>= +(defun |getMainEntryPoint| (options) + (|getOptionValue| (|Option| "main") options)) +@ + +\subsection{Saving Lisp image to disk} + +<<AxiomCore>>= +;; 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")) +@ + +\section{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. + +<<AxiomCore>>= +(defun |quit| (&optional (status 0)) + #+:sbcl (sb-ext:quit :unix-status status) + #+:clisp (ext:quit status) + #+:gcl (quit status) + #+:ecl (ext:quit status) + #-(or :sbcl :clisp :gcl :ecl) + (error "`quit' not implemented for this Lisp")) +@ + + +\section{Basic diagnostic routines} + +<<AxiomCore>>= +;; Basic diagnostic machinery: +;; 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)))) +@ + + +\section{Command line arguments} + +<<AxiomCore>>= +;; 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)))) +@ + + +\section{Program startup} + +<<AxiomCore>>= +;; 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))) +@ + +\section{Building standalone executable} + +<<AxiomCore>>= +;; 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|))) +@ + +\section{Handling command line arguments} + +<<AxiomCore>>= +(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))) +@ + +<<AxiomCore>>= +(defun |hasHandler?| (request) + (|getDriver| request)) +@ + +<<AxiomCore>>= +(defun |useFileType?| (request) + (get request 'use-file-type)) +@ + +<<AxiomCore>>= +(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))))) +@ + +\subsection{The \verb!--help! handler} + +<<AxiomCore>>= +;; 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|) +@ + + +\subsection{The \verb!--make! handler} + +<<AxiomCore>>= +(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|) +@ + +\subsection{The \verb!--load-directory! handler} + +<<AxiomCore>>= +;; 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|) +@ + + +\section{Compiling Lisp source files} + +<<AxiomCore>>= +(declaim (inline |compileFilePathname|)) +(defun |compileFilePathname| (file) + #-:ecl (compile-file-pathname file) + #+:ecl (compile-file-pathname file :type :object)) + +;; 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) + (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) + (|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|) +@ + + +\section{Predefined system entry point} + +<<AxiomCore>>= +;; 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))))) + +@ + + +\section{File system} + +\subsection{Directory name} + +<<AxiomCore>>= +;; 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 "/")))) +@ + +\section{Modules in Axiom} + +\subsection{Module load directories} + +<<AxiomCore>>= +;; List of directories to search for FASLs. +(defparameter |$LoadDirectories| nil) +@ + + +\subsection{Keeping track of imported modules} + +\subsubsection{List of imported modules} + +<<AxiomCore>>= +;; List of FASLs imported +(defparameter |$ImportedModules| nil) +@ + +\subsubsection{Updating the list of imported modules} + +<<AxiomCore>>= +;; 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|)) +@ + + +\subsection{Load pathname} + +<<AxiomCore>>= +;; 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|)) +@ + +\subsection{Module import} + +<<AxiomCore>>= +(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|)) + +(eval-when (:compile-toplevel :load-toplevel :execute) +(defmacro import-module (module) + `(progn (eval-when (:execute :compile-toplevel) + (|importModule| ,module)) + + (eval-when (:execute :load-toplevel) + (|importModule| ,module)))) +) +@ + + +\subsection{Lisp implementation-dependent support} + +\subsubsection{SBCL} + +<<AxiomCore>>= +#+ :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*)) +@ + + + +\section{Putting it all together} + +<<*>>= +<<license>> + +;(proclaim '(optimize safety)) +<<AxiomCore>> +@ + +\section{License} + +<<license>>= +;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +;; 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. + +@ + +\end{document} |