diff options
Diffstat (limited to 'src/lisp')
| -rw-r--r-- | src/lisp/ChangeLog | 14 | ||||
| -rw-r--r-- | src/lisp/Makefile.in | 15 | ||||
| -rw-r--r-- | src/lisp/Makefile.pamphlet | 15 | ||||
| -rw-r--r-- | src/lisp/core.lisp.in (renamed from src/lisp/core.lisp.pamphlet) | 672 |
4 files changed, 333 insertions, 383 deletions
diff --git a/src/lisp/ChangeLog b/src/lisp/ChangeLog index b4b96645..a60858fd 100644 --- a/src/lisp/ChangeLog +++ b/src/lisp/ChangeLog @@ -1,5 +1,19 @@ 2007-09-08 Gabriel Dos Reis <gdr@cs.tamu.edu> + * 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. + +2007-09-08 Gabriel Dos Reis <gdr@cs.tamu.edu> + * core.lisp.pamphlet (|%hasFeature|): New. 2007-09-05 Gabriel Dos Reis <gdr@cs.tamu.edu> diff --git a/src/lisp/Makefile.in b/src/lisp/Makefile.in index 26087819..b1dba434 100644 --- a/src/lisp/Makefile.in +++ b/src/lisp/Makefile.in @@ -26,7 +26,8 @@ COBJEXT = $(if $(findstring mingw, $(target)),$(OBJEXT),lo) ## code from core.lisp. However, the general interface compiler::link ## that GCL provides for that task is unsupported on Windows platforms. ## So, we instruct GCL so load the source file instead. -CORE = $(if $(findstring mingw, $(target)),core.lisp,core.$(FASLEXT)) +fasl_ext = $(if $(findstring mingw, $(target)),.lisp,.$(FASLEXT)) +FASLS = $(patsubst %,"%", $(addsuffix $(fasl_ext),core)) .PHONY: all all-lisp all: all-ax all-lisp @@ -58,7 +59,7 @@ ifeq (@axiom_lisp_flavor@,gcl) ' (compiler::*ld* (concatenate (quote string) ' \ ' $(GCL_LTLD) ' \ ' sys-ld))) ' \ - '(compiler::link (quote ("$(CORE)")) "lisp$(EXEEXT)" ' \ + '(compiler::link (quote ($(FASLS))) "lisp$(EXEEXT)" ' \ ' (format nil "(progn (let ((*load-path* (cons ~S *load-path*))'\ ' (si::*load-types* ~S))' \ ' (compiler::emit-fn t))' \ @@ -75,22 +76,22 @@ endif base-lisp$(EXEEXT): core.$(FASLEXT) $(AXIOM_LISP) \ - $(eval_flags) '(progn #+:sbcl (require :sb-cltl2))' \ - $(eval_flags) '(load "$<")' \ + $(eval_flags) '(load "core")' \ $(eval_flags) '(|AxiomCore|::|link| "$@" (quote nil) (function |AxiomCore|::|topLevel|))' -core.lisp: $(srcdir)/core.lisp.pamphlet - $(axiom_build_document) --tangle --output=$@ $< +core.lisp: $(srcdir)/core.lisp.in + cd $(top_builddir) && \ + $(SHELL) ./config.status src/lisp/sys-conf.lisp 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 *.$(FASLEXT) @rm -f $(OUT)/lisp$(EXEEXT) lisp$(EXEEXT) @rm -f stamp diff --git a/src/lisp/Makefile.pamphlet b/src/lisp/Makefile.pamphlet index 59031546..b5bb04c4 100644 --- a/src/lisp/Makefile.pamphlet +++ b/src/lisp/Makefile.pamphlet @@ -46,7 +46,7 @@ ifeq (@axiom_lisp_flavor@,gcl) ' (compiler::*ld* (concatenate (quote string) ' \ ' $(GCL_LTLD) ' \ ' sys-ld))) ' \ - '(compiler::link (quote ("$(CORE)")) "lisp$(EXEEXT)" ' \ + '(compiler::link (quote ($(FASLS))) "lisp$(EXEEXT)" ' \ ' (format nil "(progn (let ((*load-path* (cons ~S *load-path*))'\ ' (si::*load-types* ~S))' \ ' (compiler::emit-fn t))' \ @@ -63,16 +63,15 @@ endif base-lisp$(EXEEXT): core.$(FASLEXT) $(AXIOM_LISP) \ - $(eval_flags) '(progn #+:sbcl (require :sb-cltl2))' \ - $(eval_flags) '(load "$<")' \ + $(eval_flags) '(load "core")' \ $(eval_flags) '(|AxiomCore|::|link| "$@" (quote nil) (function |AxiomCore|::|topLevel|))' -core.lisp: $(srcdir)/core.lisp.pamphlet - $(axiom_build_document) --tangle --output=$@ $< +core.lisp: $(srcdir)/core.lisp.in + cd $(top_builddir) && \ + $(SHELL) ./config.status src/lisp/sys-conf.lisp 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)' @@ -108,7 +107,8 @@ COBJEXT = $(if $(findstring mingw, $(target)),$(OBJEXT),lo) ## code from core.lisp. However, the general interface compiler::link ## that GCL provides for that task is unsupported on Windows platforms. ## So, we instruct GCL so load the source file instead. -CORE = $(if $(findstring mingw, $(target)),core.lisp,core.$(FASLEXT)) +fasl_ext = $(if $(findstring mingw, $(target)),.lisp,.$(FASLEXT)) +FASLS = $(patsubst %,"%", $(addsuffix $(fasl_ext),core)) .PHONY: all all-lisp all: all-ax all-lisp @@ -122,6 +122,7 @@ stamp: $(OUT)/lisp$(EXEEXT) <<build augmented lisp>> mostlyclean-local: + rm -f *.$(FASLEXT) @rm -f $(OUT)/lisp$(EXEEXT) lisp$(EXEEXT) @rm -f stamp diff --git a/src/lisp/core.lisp.pamphlet b/src/lisp/core.lisp.in index 2e12ebc9..8722220c 100644 --- a/src/lisp/core.lisp.pamphlet +++ b/src/lisp/core.lisp.in @@ -1,24 +1,51 @@ -%% Oh Emacs, this is a -*- Lisp -*- file, despite apperance -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/lisp/core.lisp} Pamphlet} -\author{Gabriel Dos~Reis} +;; Ô 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. -\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} +;; +;; -*- 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. +;; -\section{The [[AxiomCore]] package} -<<AxiomCore>>= (defpackage "AxiomCore" #+:common-lisp (:use "COMMON-LISP") #-:common-lisp (:use "SYSTEM" "LISP" "USER") @@ -27,38 +54,55 @@ ;; is a non-ANSI compliant organization of GCL's implementation. #+:gcl (:use "DEFPACKAGE") (:export "quit" - "fatalError" - "internalError" - "error" - "errorCount" - "countError" - "warn" + "fatalError" + "internalError" + "error" + "errorCount" + "countError" + "warn" + + "%hasFeature" - "%hasFeature" - - "getCommandLineArguments" - "processCommandLine" - "handleCommandLine" - "$originalLispTopLevel" - "link" - "installDriver" - "associateRequestWithFileType" - "ensureTrailingSlash" - "getOutputPathname" - "loadPathname" - "compileLispFile" - "compileLispHandler" - "Option" - - "IMPORT-MODULE" - )) + "$hostPlatform" + "$buildPlatform" + "$targetPlatform" + + "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} +;; +;; -*- 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 -*- +;; -<<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. @@ -67,36 +111,35 @@ #+:gcl #'si::top-level #+:sbcl #'sb-impl::toplevel-init #+clisp #'system::main-loop) -@ - -\section{File types} -<<AxiomCore>>= +;; 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") -@ -\subsection{File type canonilization} - -<<AxiomCore>>= +;; 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)))) -@ + (equal "lsp" file-type)) + |$LispFileType|) + (t file-type)))) -\section{Drivers table} -\subsection{The driver table} +;; +;; -*- OpenAxiom Driver Table -*- +;; -<<AxiomCore>>= ;; Global map from requests to drivers. ;; Ideally we want to handle ;; --help: just print a help menu and exit @@ -105,28 +148,20 @@ ;; --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>>= +;; Associate DRIVER with REQUEST. (defun |installDriver| (request driver) (when (|getDriver| request) (|internalError| "attempt to override driver")) (setf (gethash request |$driverTable|) driver)) -@ -<<AxiomCore>>= -;; Register DRIVER for a REQUEST +;; 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. @@ -134,19 +169,17 @@ (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"))) -@ +;; +;; -*- OpenAxiom Command Line Parsing -*- +;; -\subsection{Parsing command line options} +;; Return a symbol object represensing option named OPT, without leading +;; double dash (--). +(defun |Option| (opt) + (intern opt (find-package "AxiomCore"))) -<<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. @@ -154,14 +187,14 @@ (setq option (subseq option 2)) (let ((p (position #\= option))) (if p - (cons (|Option| (subseq option 0 p)) (subseq option (1+ 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)))) + (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 @@ -170,56 +203,47 @@ ;; the list of processed options. (defun |processCommandLine| (argv options-so-far) (if (and argv - (equal "--" (subseq (car argv) 0 2))) + (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))))) + (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. +;; +;; -*- 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>>= + ;; 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)) -@ - -\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, @@ -229,46 +253,44 @@ current image and dumping the result on disk as an executable. ;; 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)))) + (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)) + (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)) + (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)) + (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>>= +;; +;; -*- 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) @@ -276,13 +298,11 @@ it would return $0$, meaning that everything is OK. #+:ecl (ext:quit status) #-(or :sbcl :clisp :gcl :ecl) (error "`quit' not implemented for this Lisp")) -@ -\section{Basic diagnostic routines} - -<<AxiomCore>>= -;; Basic diagnostic machinery: +;; +;; -*- 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 @@ -314,24 +334,22 @@ it would return $0$, meaning that everything is OK. (|countError|) (|diagnosticMessage| "error" (cond ((consp msg) - (reduce #'(lambda (x y) - (concatenate 'string x y)) - msg :initial-value "")) - (t 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} + (reduce #'(lambda (x y) + (concatenate 'string x y)) + msg :initial-value "")) + (t msg)))) -<<AxiomCore>>= +;; +;; -*- 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 @@ -352,18 +370,18 @@ it would return $0$, meaning that everything is OK. #-(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))) + #+: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} +;; +;; -*- Program Startup -*- +;; -<<AxiomCore>>= ;; The top level entry point to most saved Lisp image. (defun |main| nil (setq *package* (find-package "BOOT")) @@ -383,11 +401,11 @@ it would return $0$, meaning that everything is OK. ;; Huh, the main entry point was not defined. (|fatalError| "missing definition for main function") (|quit| 1))) -@ -\section{Building standalone executable} -<<AxiomCore>>= +;; +;; -*- 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.) @@ -398,40 +416,34 @@ it would return $0$, meaning that everything is OK. (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)) + (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|))) -@ + (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} +;; +;; -*- 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 @@ -447,30 +459,32 @@ it would return $0$, meaning that everything is OK. (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>>= + (|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:") @@ -488,12 +502,12 @@ it would return $0$, meaning that everything is OK. (|quit|)) (|installDriver| (|Option| "help") #'|helpHandler|) -@ -\subsection{The \verb!--make! handler} +;; +;; -*- --make Handler -*- +;; -<<AxiomCore>>= (defun |makeHandler| (prog-name options args) (declare (ignore prog-name)) (unless (> (length args) 0) @@ -503,18 +517,19 @@ it would return $0$, meaning that everything is OK. (|quit|)) (|installDriver| (|Option| "make") #'|makeHandler|) -@ -\subsection{The \verb!--load-directory! handler} -<<AxiomCore>>= +;; +;; -*- --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|)) + (special |$LoadDirectories|)) (let ((load-option (assoc (|Option| "load-directory") options))) (unless load-option (|internalError| "`recordLoadDirectory' called without option")) @@ -524,12 +539,10 @@ it would return $0$, meaning that everything is OK. )) (|installDriver| (|Option| "load-directory") #'|recordLoadDirectory|) -@ - -\section{Compiling Lisp source files} - -<<AxiomCore>>= +;; +;; -*- --compile Handler for Lisp Source Files -*- +;; (declaim (inline |compileFilePathname|)) (defun |compileFilePathname| (file) #-:ecl (compile-file-pathname file) @@ -537,10 +550,10 @@ it would return $0$, meaning that everything is OK. (defun |currentDirectoryName| nil (let* ((dir (namestring (truename ""))) - (n (1- (length dir)))) + (n (1- (length dir)))) (if (char= (char dir n) #\/) - (subseq dir 0 n) - dir))) + (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 @@ -566,49 +579,49 @@ it would return $0$, meaning that everything is OK. ;; 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|))))) + (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)) + #-: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)))) + (|compileFilePathname| file)))) (|compileLispFile| file out-file))) (|associateRequestWithFileType| (|Option| "compile") |$LispFileType| #'|compileLispHandler|) -@ -\section{Predefined system entry point} +;; +;; -*- Predefined System Entry Point -*- +;; -<<AxiomCore>>= ;; The top level entry point to most saved Lisp image. (defun |topLevel|() (setq *package* (find-package "AxiomCore")) @@ -624,7 +637,7 @@ it would return $0$, meaning that everything is OK. ;; 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 @@ -635,71 +648,47 @@ it would return $0$, meaning that everything is OK. (|handleCommandLine| (car command-args) options args) (|quit| (if (> (|errorCount|) 0) 1 0))))) -@ +;; +;; -*- Filesystem Utilities -*- +;; -\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 + dir (concatenate 'string dir "/")))) -@ -\section{Modules in Axiom} -\subsection{Module load directories} +;; +;; -*- Modules in OpenAxiom -*- +;; -<<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>>= +(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|)) -@ - -\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} + :name module + #-:ecl :type #-:ecl |$faslType|)) -<<AxiomCore>>= (defun |loadIfPresent| (module) (if (|alreadyLoaded?| module) module @@ -718,9 +707,9 @@ it would return $0$, meaning that everything is OK. (unless directories (|fatalError| (format nil - "module ~S not found in search path ~S" - module - |$LoadDirectories|))) + "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))))) @@ -730,25 +719,20 @@ it would return $0$, meaning that everything is OK. (defmacro import-module (module) `(progn (eval-when - #+:common-lisp (:compile-toplevel :load-toplevel :execute) - #-:common-lisp (compile load eval) - (|importModule| ,module)))) - -@ + #+:common-lisp (:compile-toplevel :load-toplevel :execute) + #-:common-lisp (compile load eval) + (|importModule| ,module)))) -\subsection{Lisp implementation-dependent support} - -\subsectionFeature tests} +;; +;; -*- Feature Tests in Boot -*- +;; -<<AxiomCore>>= (defun |%hasFeature| (f) (member f *features* :test #'eq)) -@ -\subsubsection{SBCL} +;; -*- Lisp Implementatiom-dependen Supports -*- -<<AxiomCore>>= #+ :sbcl (defun shoe-provide-module(name) (load name) @@ -757,53 +741,3 @@ it would return $0$, meaning that everything is OK. #+ :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} |