Initial population.

1 files changed, 243 insertions, 0 deletions

diff --git a/src/boot/initial-env.lisp.pamphlet b/src/boot/initial-env.lisp.pamphlet
new file mode 100644
index 00000000..f06b6a65
--- /dev/null
+++ b/src/boot/initial-env.lisp.pamphlet
@@ -0,0 +1,243 @@
+%% Oh Emacs, this is a -*- Lisp -*- file despite apperance.
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/boot/initial-env.lisp} Pamphlet}
+\author{Gabriel Dos~Reis \and Timothy Daly}
+
+\begin{document}
+\maketitle
+
+\begin{abstract}
+  This pamphlet defines the base initial environment for building
+  a Boot translator image.  It essentially etablishes a namespace
+  (package \Code{Boot}) for the Boot translator, and defines 
+  some macros that need to be present during translation of Boot
+  source files.
+\end{abstract}
+
+\tableofcontents
+\eject
+
+\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.
+
+@
+
+\section{The \code{BOOTTRAN} package}
+
+All Boot translator functions are defined in the package
+\code{BOOTTRAN}.  It is expected that the translator interfaces
+with the rest of the system only through the functions explicitly exported
+by \code{BOOTTRAN}:
+<<boot-translator>>=
+(defpackage "BOOTTRAN"
+  (:use "AxiomCore")
+  #+:common-lisp  (:use "COMMON-LISP")
+  #-:common-lisp  (:use "LISP" "SYSTEM"))
+
+@
+
+\section{I/O macros}
+
+The Boot translator source codes make uses of some 
+higher order functions.  For various reasons, including efficiency,
+they are defined as Lisp macros and must therefore be available in each
+source file that uses them.
+
+\subsection{[[shoeInputFile]]}
+
+<<with-input-file>>=
+(defmacro |shoeOpenInputFile|
+     (stream fn prog)
+    `(with-open-file (,stream ,fn :direction :input
+       :if-does-not-exist nil) ,prog))
+@
+
+This macro creates a input stream object from a file name [[fn]], and 
+processes it with [[prog]].  If the file name designates a non-existent 
+file, the standard input is used instead.
+
+\subsection{[[shoeOpenOutputFile]]}
+<<with-output-file>>=
+(defmacro |shoeOpenOutputFile|
+     (stream fn prog)
+    `(with-open-file (,stream ,fn :direction :output
+       :if-exists :supersede) ,prog))
+@
+
+This macro creates an output stream object from a file name [[fn]], and 
+processes it with [[prog]].  The output file is overwritten if it exists.
+
+\section{Putting it together}
+
+<<*>>=
+<<license>>
+
+<<boot-translator>>
+
+(in-package "BOOTTRAN")
+
+;## need the conditional here so it appears in boottran
+#+:ieee-floating-point (defparameter $ieee t)
+#-:ieee-floating-point (defparameter $ieee nil)
+
+(defmacro memq (a b) `(member ,a ,b :test #'eq))
+(defvar *lisp-bin-filetype* "o")
+(defvar *lisp-source-filetype* "lisp")
+(defun setdifference (x y) (set-difference x y))
+(defun make-cvec (sint) (make-string sint))
+(defun MAKE-VEC (n) (make-array n))
+(defun concat (&rest l)
+  (progn
+    (setq l (mapcar #'string l))
+    (apply #'concatenate 'string l)))
+
+(defun |shoeInputFile| (filespec )
+  (open filespec :direction :input :if-does-not-exist nil))
+
+<<with-input-file>>
+
+<<with-output-file>>
+
+(defun shoeprettyprin1 (x &optional (stream *standard-output*))
+  (let ((*print-pretty* t)
+	(*print-array* t)
+	(*print-circle* t)
+	(*print-level* nil)
+	(*print-length* nil))
+    (prin1 x stream)))
+ 
+(defun reallyprettyprint (x &optional (stream *terminal-io*))
+  (shoeprettyprin1 x stream) (terpri stream))
+ 
+(defun shoeprettyprin0 (x &optional (stream *standard-output*))
+  (let ((*print-pretty* nil)
+	(*print-array* t)
+	(*print-circle* t)
+	(*print-level* nil)
+	(*print-length* nil))
+    (prin1 x stream)))
+ 
+(defun shoenotprettyprint (x &optional (stream *terminal-io*))
+  (shoeprettyprin0 x stream) (terpri stream))
+
+(defun make-full-cvec (sint &optional (char #\space))
+  (make-string sint :initial-element (character char)))
+
+(defun |shoePLACEP| (item) 
+  (eq item nil))
+
+(defun substring (cvec start length)
+  (if length (subseq cvec start (+ start length))
+    (subseq cvec start)))
+
+(defun MAKE-HASHTABLE (id1)
+  (let ((test (case id1
+		    ((EQ ID) #'eq)
+		    (CVEC #'equal)
+		    ((UEQUAL EQUAL) #'equal)
+		    (otherwise (error "bad arg to make-hashtable")))))
+    (make-hash-table :test test)))
+
+(defun HKEYS (table)
+  (let (keys)
+    (maphash #'(lambda (key val) 
+		 (declare (ignore val))
+		 (push key keys)) table)
+    keys))
+
+
+(defun HPUT (table key value)
+  (setf (gethash key table) value))
+ 
+(defun QENUM (cvec ind)
+  (char-code (char cvec ind)))
+ 
+(defun charmem (a b)
+  (member  a  b :test #'eql))
+
+(defun |shoeIdChar| (x)
+  (or (ALPHANUMERICP x)
+      (charmem x '(#\' #\? #\%))))
+
+(defun |shoeStartsId| (x)
+  (or (alpha-char-p x)
+      (charmem x '(#\$ #\? #\%))))
+ 
+(defun strpos (what in start dontcare)
+  (setq what (string what) in (string in))
+  (if dontcare (progn (setq dontcare (character dontcare))
+		      (search what in :start2 start
+			      :test #'(lambda (x y) (or (eql x dontcare)
+							(eql x y)))))
+    (search what in :start2 start)))
+ 
+
+(defun strposl (table cvec sint item)
+  (setq cvec (string cvec))
+  (if (not item)
+      (position table cvec :test #'(lambda (x y) (position y x)) :start sint)
+    (position table cvec :test-not #'(lambda (x y) (position y x))
+	      :start sint  )))
+
+(defun VEC-SETELT (vec ind val) 
+  (setf (elt vec ind) val))
+
+(defun  bvec-make-full (n x)
+  (make-array (list n) :element-type 'bit :initial-element x))
+
+(defun make-bvec (n)
+  (bvec-make-full n 0))
+ 
+(defun bvec-setelt (bv i x)
+  (setf (sbit bv i) x))
+
+(defun size (l)
+  (cond ((vectorp l) (length l))
+	((consp l) (list-length l))
+	(t 0)))
+
+(defun identp (a) 
+  (and (symbolp a) a))
+
+(defun |shoeReadLisp| (s n)
+  (multiple-value-list (read-from-string s nil nil :start n)))
+
+(defun |last| (x)
+  (car (last x)))
+@
+
+
+\end{document}