From ab8cc85adde879fb963c94d15675783f2cf4b183 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 14 Aug 2007 05:14:52 +0000
Subject: Initial population.
---
src/lisp/ChangeLog | 157 +++++++++
src/lisp/Makefile.in | 75 +++++
src/lisp/Makefile.pamphlet | 113 +++++++
src/lisp/core.lisp.pamphlet | 775 ++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 1120 insertions(+)
create mode 100644 src/lisp/ChangeLog
create mode 100644 src/lisp/Makefile.in
create mode 100644 src/lisp/Makefile.pamphlet
create mode 100644 src/lisp/core.lisp.pamphlet
(limited to 'src/lisp')
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}
--
cgit v1.2.3