Index: src//clx/clx.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/clx/clx.lisp,v
retrieving revision 1.11
diff -u -b -r1.11 clx.lisp
--- src//clx/clx.lisp	1999/03/16 23:37:37	1.11
+++ src//clx/clx.lisp	1999/09/06 01:27:30
@@ -85,6 +85,7 @@
 
 (pushnew :clx *features*)
 (pushnew :xlib *features*)
+(setf *features* (remove :no-clx *features*))
 
 (defparameter *version* "MIT R5.02")
 (pushnew :clx-mit-r4 *features*)
Index: src//code/class.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/class.lisp,v
retrieving revision 1.42
diff -u -b -r1.42 class.lisp
--- src//code/class.lisp	2000/01/10 14:43:54	1.42
+++ src//code/class.lisp	2000/01/11 20:01:17
@@ -789,7 +789,11 @@
 	  (setf (info type builtin name) class))
 	(let* ((inheritance-depth (if hierarchical (length inherits) -1))
 	       (inherit-layouts
-		(map 'vector
+		(#-high-security
+		 map
+		 #+high-security
+		 lisp::map-without-errorchecking
+		     'vector
 		     #'(lambda (x)
 			 (let ((super-layout (class-layout (find-class x))))
 			   (when (= (layout-inheritance-depth super-layout) -1)
@@ -813,7 +817,11 @@
       (setf (info type class name) class-cell)
       (setf (info type kind name) :instance)
       (let ((inherit-layouts
-	     (map 'vector #'(lambda (x)
+	     (#-high-security
+	      map
+	      #+high-security
+	      lisp::map-without-errorchecking
+	      'vector #'(lambda (x)
 			      (lisp::class-layout (lisp:find-class x)))
 		  inherits)))
 	(lisp::register-layout (lisp::find-layout name 0 inherit-layouts -1)
Index: src//code/clx-ext.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/clx-ext.lisp,v
retrieving revision 1.14
diff -u -b -r1.14 clx-ext.lisp
--- src//code/clx-ext.lisp	1997/08/06 12:25:07	1.14
+++ src//code/clx-ext.lisp	1999/09/06 01:27:30
@@ -52,7 +52,7 @@
 	   ;;pw-- "unix" is a signal to the connect_to_inet C code
 	   ;;     to open an AF_UNIX socket instead of an AF_INET one.
 	   ;;     This is supposed to be faster on a local server.
-	   (host-name "unix")
+	   (host-name "") ;; PVE "" works better...
 	   (auth-name nil)
 	   (auth-data nil)
 	   (display-num nil)
Index: src//code/commandline.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/commandline.lisp,v
retrieving revision 1.6
diff -u -b -r1.6 commandline.lisp
--- src//code/commandline.lisp	1996/05/08 02:03:08	1.6
+++ src//code/commandline.lisp	1999/12/09 21:30:38
@@ -196,4 +196,5 @@
 (defswitch "init")
 (defswitch "noinit")
 (defswitch "hinit")
+(defswitch "lazy")
 
Index: src//code/fd-stream.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/fd-stream.lisp,v
retrieving revision 1.50
diff -u -b -r1.50 fd-stream.lisp
--- src//code/fd-stream.lisp	1999/12/04 16:02:34	1.50
+++ src//code/fd-stream.lisp	1999/12/06 19:01:44
@@ -1404,8 +1404,11 @@
 			      (list pathname (unix:get-unix-error-msg errno))))
 		     (:create
 		      (cerror "Return NIL."
+			      'simple-error
+			      :format-control
 			      "Error creating ~S, path does not exist."
-			      pathname)))
+			      :format-arguments
+			      (list pathname))))
 		   (return nil))
 		  ((eql errno unix:eexist)
 		   (unless (eq nil if-exists)
@@ -1448,7 +1451,10 @@
   (setf *terminal-io* (make-synonym-stream '*tty*))
   (setf *standard-output* (make-synonym-stream '*stdout*))
   (setf *standard-input*
-	(make-two-way-stream (make-synonym-stream '*stdin*)
+	(#-high-security
+	 make-two-way-stream
+	 #+high-security
+	 %make-two-way-stream (make-synonym-stream '*stdin*)
 			     *standard-output*))
   (setf *error-output* (make-synonym-stream '*stderr*))
   (setf *query-io* (make-synonym-stream '*terminal-io*))
Index: src//code/filesys.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/filesys.lisp,v
retrieving revision 1.56
diff -u -b -r1.56 filesys.lisp
--- src//code/filesys.lisp	1999/06/03 15:55:49	1.56
+++ src//code/filesys.lisp	1999/09/06 01:27:30
@@ -528,6 +528,16 @@
 				   verify-existance function)))
 	(%enumerate-files "" pathname verify-existance function))))
 
+;;; This has been altered quite substantially.  
+
+;;; 1. :wild and :wild-inferiors were not patterns, and so are now
+;;; treated separately;
+
+;;; 2. Links to directories are no longer followed when
+;;; :wild-inferiors is being processed, due to the danger on systems
+;;; with linux and /proc filesystems infested with links to the root
+;;; directory. (Infinite loops: bad)
+
 (defun %enumerate-directories (head tail pathname verify-existance function)
   (declare (simple-string head))
   (if tail
@@ -537,7 +547,28 @@
 	   (%enumerate-directories (concatenate 'string head piece "/")
 				   (cdr tail) pathname verify-existance
 				   function))
-	  ((or pattern (member :wild :wild-inferiors))
+	  ((member :wild)
+	   (let ((dir (unix:open-dir head)))
+	     (when dir
+	       (unwind-protect
+		   (loop
+		     (let ((name (unix:read-dir dir)))
+		       (cond ((null name)
+			      (return))
+			     ((string= name "."))
+			     ((string= name ".."))
+			     (t
+			      (let ((subdir (concatenate 'string
+							 head name)))
+				;; see below for health warning
+				(when (eq (unix:unix-file-kind subdir t)
+					  :directory)
+				  (%enumerate-directories
+				   (concatenate 'string subdir "/")
+				   (cdr tail) pathname verify-existance
+				   function)))))))
+		 (unix:close-dir dir)))))	   
+	  ((member :wild-inferiors)
 	   (let ((dir (unix:open-dir head)))
 	     (when dir
 	       (unwind-protect
@@ -547,6 +578,32 @@
 			      (return))
 			     ((string= name "."))
 			     ((string= name ".."))
+			     (t ; always match 
+			      ;; warning - this depends
+			      ;; on lstat behaving in the same way on
+			      ;; different platforms. Basically,
+			      ;; lstat("foo") -> :link, lstat("foo/")
+			      ;; -> directory on linux 2.2.
+			      (let ((subdir (concatenate 'string
+							 head name)))
+				(when (eq (unix:unix-file-kind subdir t)
+					  :directory)
+				  (%enumerate-directories
+				   (concatenate 'string subdir "/")
+				   tail pathname verify-existance
+				   function)))))))
+		 (unix:close-dir dir))
+	       (%enumerate-files head pathname verify-existance	function))))
+	  (pattern
+	   (let ((dir (unix:open-dir head)))
+	     (when dir
+	       (unwind-protect
+		   (loop
+		     (let ((name (unix:read-dir dir)))
+		       (cond ((null name)
+			      (return))
+			     ((string= name "."))
+			     ((string= name ".."))
 			     ((pattern-matches piece name)
 			      (let ((subdir (concatenate 'string
 							 head name "/")))
@@ -816,37 +873,217 @@
 
 ;;; DIRECTORY  --  public.
 ;;; 
-(defun directory (pathname &key (all t) (check-for-subdirs t)
-			   (follow-links t))
-  "Returns a list of pathnames, one for each file that matches the given
-   pathname.  Supplying :ALL as nil causes this to ignore Unix dot files.  This
-   never includes Unix dot and dot-dot in the result.  If :FOLLOW-LINKS is NIL,
-   then symblolic links in the result are not expanded.  This is not the
-   default because TRUENAME does follow links, and the result pathnames are
-   defined to be the TRUENAME of the pathname (the truename of a link may well
-   be in another directory.)"
-  (let ((results nil))
-    (enumerate-search-list
-	(pathname (merge-pathnames pathname
+
+;;; modified 13/Apr/1999 csr21@cam.ac.uk Christophe Rhodes
+(defun directory (pathname &key (all t) (check-for-subdirs nil) (delete-duplicates nil) (follow-links nil) (resolve-links nil) (sort nil))
+  "Returns a list of pathnames, one for each file that matches the
+given pathname. Keyword arguments:
+
+all: If false, will ignore files with names beginning with a #\\.  
+
+check-for-subdirs: If true, will check the file to see if it is
+actually a directory, and if so the resultant pathname will reflect
+such.
+
+delete-duplicates: If true, will delete duplicate pathnames in the
+result list.
+
+follow-links: if true, will treat links linked to directories as
+directories. Warning: this may cause infinite loops if a symlink
+points to an ancestor (/proc/ on Linux is a spectacular example of
+this).
+
+resolve-links: if true, will attempt to resolve links in the resultant
+list (via truename). Duplicates resulting from the resolving process
+will be removed if delete-duplicates is non-nil.
+
+sort: if true, will attempt to sort the results alphabetically."
+  ;; I don't think that this can result in any
+  ;; duplicates. Let me know if you think otherwise.
+  (let ((answer 
+	 (dir (merge-pathnames pathname 
 				   (make-pathname :name :wild
-						  :type :wild
-						  :version :wild)))
-      (enumerate-matches (name pathname)
-	(when (or all
-		  (let ((slash (position #\/ name :from-end t)))
-		    (or (null slash)
-			(= (1+ slash) (length name))
-			(char/= (schar name (1+ slash)) #\.))))
-	  (push name results))))
+					      :type :wild))
+	      :all all
+	      :check-for-subdirs check-for-subdirs
+	      :follow-links follow-links
+	      :sort sort)))
+    ;; If the above assertion is correct, then this one is not needed.
+    (when delete-duplicates
+      (setf answer (delete-duplicates answer :test #'string=)))
+    (setf answer
+	  (if resolve-links
+	      (mapcar #'(lambda (x)
     (let ((*ignore-wildcards* t))
-      (mapcar #'(lambda (name)
-		  (let ((name (if (and check-for-subdirs
-				       (eq (unix:unix-file-kind name)
-					   :directory))
-				  (concatenate 'string name "/")
-				  name)))
-		    (if follow-links (truename name) (pathname name))))
-	      (sort (delete-duplicates results :test #'string=) #'string<)))))
+			    (truename (parse-namestring x))))
+		      answer)
+	    (mapcar #'(lambda (x)
+			(let ((*ignore-wildcards* t))
+			  (parse-namestring x)))
+		    answer)))
+    (when delete-duplicates
+      (setf answer (delete-duplicates answer :test #'pathname=)))
+    answer))
+
+
+(defun dir (pathname &key all check-for-subdirs follow-links sort)
+  "Returns namestrings (suitable for parse-namestring) for all files
+matching the specification of pathname."
+  (let ((directory (pathname-directory pathname)))
+    (let ((answer (loop for d in (matching-directories directory '("") :all all :follow-links follow-links :sort sort)
+			append (matching-files d pathname :all all :sort sort))))
+      (if check-for-subdirs
+	  (mapcar #'(lambda (filename) 
+		      (if (eq :directory (unix:unix-file-kind filename (not follow-links)))
+			  (concatenate 'string filename "/")
+			filename))
+		  answer)
+	answer))))
+
+(defun directory-contents (dirstring &key (all t) (ignore-dots t) sort)
+  "Return a list of all files returned by unix:read-dir in the
+directory named by dirstring. If :ignore-dots is t (the default), then
+\".\" and \"..\" are not included. If all is nil, filenames beginning
+with #\\. are removed from the results."
+  (let ((dir (unix:open-dir dirstring)))
+    (let ((result (when dir
+		    (let ((contents (unwind-protect
+					(loop when (unix:read-dir dir)
+					      collect it
+					      else do (loop-finish))
+				      (unix:close-dir dir))))
+		      (unless all
+			(setf contents 
+			      (remove-if #'(lambda (filename) 
+					     (char= (aref filename 0) #\.))
+					 contents)))
+		      (if ignore-dots
+			  (remove-if #'(lambda (f) (or (equal f ".")
+						       (equal f "..")))
+				     contents)
+			contents)))))
+      (when sort
+	(setf result (sort result #'string<)))
+      result)))
+
+;;; The logic behind some of these cases is slightly contorted, but, I
+;;; believe, correct.
+(defun matching-directories (directory &optional (result '("")) &key all follow-links sort)
+  "Return a list of strings naming all directories matching the
+directory spec. If directory is a string, pathname-directory is called
+on it."
+  (labels ((string-add (string &key endp) 
+	    #'(lambda (s) (if endp
+			      (concatenate 'string s string)
+			    (concatenate 'string string s)))))
+    (when (typep directory 'string)
+      (setf directory (pathname-directory directory)))
+    (typecase (car directory)
+      ;; no more directory -- therefore, result contains all matching
+      ;; directories.
+      (null result)
+      ;; :absolute and :relative should reset the result list.
+      ((member :absolute) (matching-directories (cdr directory) '("/")
+						:all all
+						:follow-links follow-links
+						:sort sort))
+      ((member :relative) (matching-directories (cdr directory) '("")
+						:all all
+						:follow-links follow-links
+						:sort sort))
+      ;; this one's not too hard either, since .. is always valid, and
+      ;; I don't think we should protect people against (directory
+      ;; "/../") even if it weren't -- it's their problem.
+      ((member :up) (matching-directories (cdr directory) (mapcar (string-add "../" :endp t) result) :all all :follow-links follow-links :sort sort))
+      ;; We want all the directories such that each directory
+      ;; currently in the results list is checked for subdirectories
+      ;; that match the pattern.
+      ((satisfies pattern-p)
+       (let ((directories
+	      (remove-if-not 
+	       #'(lambda (file) (eq :directory (unix:unix-file-kind file (not follow-links))))
+	       (apply #'append 
+		      (mapcar #'(lambda (d) 
+				  (mapcar (string-add d) 
+					  (remove-if-not
+					   #'(lambda (str)
+					       (pattern-matches 
+						(car directory)
+						str))
+					      (directory-contents d :all all :sort sort))))
+			      result)))))
+       (matching-directories (cdr directory) (mapcar (string-add "/" :endp t) directories) :follow-links follow-links :all all :sort sort)))
+      ;; If the first directory entry is :wild, then we want all
+      ;; directories (remove-if-not-directory) contained in all of the
+      ;; directories currently in result.
+      ((member :wild)
+       (let ((directories 
+	      (remove-if-not 
+	       #'(lambda (file) (eq :directory (unix:unix-file-kind file (not follow-links))))
+	       (apply #'append 
+		      (mapcar #'(lambda (d) 
+				  (mapcar (string-add d) (directory-contents d :all all :sort sort))) 
+			      result)))))
+	 (when directories
+	   (matching-directories (cdr directory)
+				 (mapcar (string-add "/" :endp t) directories)
+				 :follow-links follow-links :all all :sort sort))))
+      ;; (:wild-inferiors ,@foo) is equivalent to (:wild
+      ;; :wild-inferiors ,@foo) and (,@foo).  The slowness resulting
+      ;; is due to the fact that each level requires traversal of all
+      ;; previous levels. I can't think of a nice way to do this -- it
+      ;; may have to be special-cased. However, it is tolerable now, I
+      ;; believe.  Sorting has to be done here too, as we are doing a
+      ;; recursion rightwards but sorting from the left.
+      ((member :wild-inferiors)
+       (let ((temp (append (matching-directories (cons :wild directory) result :follow-links follow-links :all all :sort sort)
+			   (matching-directories (cdr directory) result :follow-links follow-links :all all :sort sort))))
+	 (when sort
+	   (setf temp (sort temp #'string<)))
+	 temp))
+      (string (matching-directories 
+	       (cdr directory)
+	       (mapcar (string-add "/" :endp t)
+		       (remove-if-not
+			#'(lambda (file) (eq :directory (unix:unix-file-kind file (not follow-links))))
+			(mapcar (string-add (car directory) :endp t) result)))
+	       :follow-links follow-links :all all :sort sort)))))
+				    
+(defun matching-files (directory pathname &key all sort)
+  "Returns a list of strings naming all files in directory matching
+the name, type and version fields of pathname."
+  (let ((name (pathname-name pathname))
+	(type (pathname-type pathname))
+	(version (pathname-version pathname)))
+    (cond
+     ((member name '(nil :unspecific)) ())
+     ;; there's still a nasty interaction here on versioned
+     ;; files. (pathname-version "/home/csr21/*") => :newest.
+     ((or (pattern-p name)
+	  (pattern-p type)
+	  (eq name :wild)
+	  (eq type :wild))
+       (loop for file in (directory-contents directory :all all :sort sort)
+	     if (multiple-value-bind
+		    (file-name file-type file-version)
+		    (let ((*ignore-wildcards* t))
+		      (extract-name-type-and-version file 0 (length file)))
+		  (and (components-match file-name name)
+		       (components-match file-type type)
+		       (components-match file-version version)))
+	     collect (concatenate 'string directory file)))
+     ;; name is a string
+     (t 
+      (let ((file (concatenate 'string directory name)))
+	(unless (or (null type) (eq type :unspecific))
+	  (setf file (concatenate 'string file "." type)))
+	(unless (member version '(nil :newest :wild))
+	  (setf file (concatenate 'string file "."
+				  (quick-integer-to-string version))))
+	;; return nil if the file doesn't exist
+	(when (unix:unix-file-kind file) (list file))))
+      )))
+		  
 
 
 ;;;; Printing directories.
@@ -1212,7 +1449,8 @@
 
 (defun filesys-init ()
   (setf *default-pathname-defaults*
-	(%make-pathname *unix-host* nil nil nil nil :newest))
+        #+:unix (%make-pathname *unix-host* nil nil nil nil :unspecific)
+	#-:unix (%make-pathname *unix-host* nil nil nil nil :newest))
   (setf (search-list "default:") (default-directory))
   nil)
 
Index: src//code/float.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/float.lisp,v
retrieving revision 1.20
diff -u -b -r1.20 float.lisp
--- src//code/float.lisp	1999/11/19 15:12:36	1.20
+++ src//code/float.lisp	1999/11/25 20:06:54
@@ -351,7 +351,10 @@
 (defun float-radix (f)
   "Returns (as an integer) the radix b of its floating-point
    argument."
+  #-high-security
   (declare (ignore f))
+  #+high-security
+  (check-type f float)
   2)
 
 
Index: src//code/gc.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/gc.lisp,v
retrieving revision 1.24
diff -u -b -r1.24 gc.lisp
--- src//code/gc.lisp	1999/12/04 16:02:35	1.24
+++ src//code/gc.lisp	1999/12/06 19:01:45
@@ -356,6 +356,9 @@
 ;;; 
 ;;; For GENCGC all generations < GEN will be GC'ed.
 ;;;
+
+(locally (declare #+high-security (optimize (debug 2)))
+
 (defun sub-gc (&key (verbose-p *gc-verbose*) force-p #+gencgc (gen 0))
   (unless *already-maybe-gcing*
     (let* ((*already-maybe-gcing* t)
@@ -409,6 +412,7 @@
 	  (scrub-control-stack)))
       (incf *gc-run-time* (- (get-internal-run-time) start-time))))
   nil)
+)
 
 ;;;
 ;;; MAYBE-GC -- Internal
Index: src//code/load.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/load.lisp,v
retrieving revision 1.74
diff -u -b -r1.74 load.lisp
--- src//code/load.lisp	1999/02/25 13:02:58	1.74
+++ src//code/load.lisp	1999/09/06 01:27:30
@@ -530,8 +530,12 @@
 	       (let ((pn (merge-pathnames (pathname filename)
 					  *default-pathname-defaults*)))
 		 (if (wild-pathname-p pn)
-		     (dolist (file (directory pn) t)
-		       (internal-load pn file if-does-not-exist contents))
+		     (let ((files (directory pn)))
+		       #+high-security
+		       (when (null files)
+			 (error 'file-error :pathname filename))
+		       (dolist (file files t)
+			 (internal-load pn file if-does-not-exist contents)))
 		     (let ((tn (probe-file pn)))
 		       (if (or tn (pathname-type pn) contents)
 			   (internal-load pn tn if-does-not-exist contents)
Index: src//code/macros.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/macros.lisp,v
retrieving revision 1.60
diff -u -b -r1.60 macros.lisp
--- src//code/macros.lisp	1999/09/15 15:12:41	1.60
+++ src//code/macros.lisp	1999/09/06 01:27:30
@@ -1337,6 +1337,21 @@
 	 (setf ,place
 	       (check-type-error ',place ,place-value ',type ,type-string))))))
 
+#+high-security-support
+(defmacro check-type-var (place type-var &optional type-string)
+  "Signals an error of type type-error if the contents of place are not of the
+   specified type to which the type-var evaluates.  If an error is signaled,
+   this can only return if STORE-VALUE is invoked.  It will store into place
+   and start over."
+  (let ((place-value (gensym))
+	(type-value (gensym)))
+    `(loop
+       (let ((,place-value ,place)
+	     (,type-value  ,type-var))
+	 (when (typep ,place-value ,type-value) (return nil))
+	 (setf ,place
+	       (check-type-error ',place ,place-value ,type-value ,type-string))))))
+
 (defun check-type-error (place place-value type type-string)
   (let ((cond (if type-string
 		  (make-condition 'simple-type-error
Index: src//code/save.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/save.lisp,v
retrieving revision 1.36
diff -u -b -r1.36 save.lisp
--- src//code/save.lisp	1998/06/24 20:30:36	1.36
+++ src//code/save.lisp	1999/09/06 01:27:30
@@ -174,7 +174,9 @@
 				    :test #'(lambda (x y)
 					      (declare (simple-string x y))
 					      (string-equal x y)))))
-		  (when site-init
+		  (when (and site-init
+			     (not (and process-command-line
+				       (find-switch "noinit"))))
 		    (load site-init :if-does-not-exist nil :verbose nil))
 		  (when (and process-command-line (find-switch "edit"))
 		    (setf *editor-lisp-p* t))
Index: src//code/seq.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/seq.lisp,v
retrieving revision 1.33
diff -u -b -r1.33 seq.lisp
--- src//code/seq.lisp	1998/07/19 01:41:26	1.33
+++ src//code/seq.lisp	1999/09/06 01:27:30
@@ -602,7 +602,10 @@
     ((simple-vector simple-string vector string array simple-array
 		    bit-vector simple-bit-vector base-string
 		    simple-base-string)
-     (apply #'concat-to-simple* output-type-spec sequences))
+     (let ((result (apply #'concat-to-simple* output-type-spec sequences)))
+       #+high-security
+       (check-type-var result output-type-spec)
+       result))
     (list (apply #'concat-to-list* sequences))
     (t
      (apply #'concatenate (result-type-or-lose output-type-spec) sequences))))
@@ -671,6 +674,19 @@
 
 )
 
+#+high-security-support
+(defun get-minimum-length-sequences (sequences)
+  "Gets the minimum length of the sequences. This is
+needed to check if the supplied type is appropriate."
+    (let ((min nil))
+      (dolist (i sequences)      
+	(when (or (listp i) (vectorp i))
+	  (let ((l (length i)))
+	    (when (or (null min)
+		      (> min l)))
+	    (setf min l))))
+      min))
+
 (defun map (output-type-spec function first-sequence &rest more-sequences)
   "FUNCTION must take as many arguments as there are sequences provided.  The 
    result is a sequence such that element i is the result of applying FUNCTION
@@ -681,6 +697,45 @@
       (list (map-to-list function sequences))
       ((simple-vector simple-string vector string array simple-array
 		    bit-vector simple-bit-vector base-string simple-base-string)
+       #+high-security
+       (let ((min-length-sequences (get-minimum-length-sequences
+				    sequences)) 
+	     (dimensions (array-type-dimensions (specifier-type
+						 output-type-spec))))
+	 (when (or (/= (length dimensions) 1)
+		   (and (not (eq (car dimensions) '*))
+			(/= (car dimensions) min-length-sequences)))
+	   (error 'simple-type-error
+		  :datum output-type-spec
+		  :expected-type
+		  (ecase (type-specifier-atom output-type-spec)
+		    ((simple-vector bit-vector simple-bit-vector string simple-string base-string)
+		     `(,(type-specifier-atom output-type-spec) ,min-length-sequences))
+		    ((array vector simple-array)   `(,(type-specifier-atom output-type-spec) * ,min-length-sequences)))
+		  :format-control "Minimum length of sequences is ~S, this is not compatible with the type ~S."
+		  :format-arguments
+		  (list min-length-sequences output-type-spec))))	   
+       (let ((result (map-to-simple output-type-spec function sequences)))
+           #+high-security
+	   (check-type-var result output-type-spec)
+	   result))
+      (t
+       (apply #'map (result-type-or-lose output-type-spec t)
+	      function sequences)))))
+
+#+high-security-support
+(defun map-without-errorchecking
+    (output-type-spec function first-sequence &rest more-sequences)
+  "FUNCTION must take as many arguments as there are sequences provided.  The 
+   result is a sequence such that element i is the result of applying FUNCTION
+   to element i of each of the argument sequences. This version has no
+   error-checking, to pass cold-load."
+  (let ((sequences (cons first-sequence more-sequences)))
+    (case (type-specifier-atom output-type-spec)
+      ((nil) (map-for-effect function sequences))
+     (list (map-to-list function sequences))
+      ((simple-vector simple-string vector string array simple-array
+		    bit-vector simple-bit-vector base-string simple-base-string)       
        (map-to-simple output-type-spec function sequences))
       (t
        (apply #'map (result-type-or-lose output-type-spec t)
@@ -842,7 +897,11 @@
   (flet ((coerce-error ()
 	   (error 'simple-type-error
 		  :format-control "~S can't be converted to type ~S."
-		  :format-arguments (list object output-type-spec))))
+		  :format-arguments (list object output-type-spec)))
+	 (check-result (result)
+	   #+high-security
+	   (check-type-var result output-type-spec)
+	   result))
     (let ((type (specifier-type output-type-spec)))
       (cond
 	((%typep object output-type-spec)
@@ -852,6 +911,33 @@
 	((csubtypep type (specifier-type 'character))
 	 (character object))
 	((csubtypep type (specifier-type 'function))
+	 #+high-security
+	 (when (and (or (symbolp object)
+			(and (listp object)
+			     (= (length object) 2)
+			     (eq (car object) 'setf)))
+		    (not (fboundp object)))
+	   (error 'simple-type-error
+		  :datum object
+		  :expected-type '(satisfies fboundp)
+	       :format-control "~S isn't fbound."
+	       :format-arguments (list object)))
+	 #+high-security
+	 (when (and (symbolp object)
+		    (macro-function object))
+	   (error 'simple-type-error
+		  :datum object
+		  :expected-type '(not (satisfies macro-function))
+		  :format-control "~S is a macro."
+		  :format-arguments (list object)))
+	 #+high-security
+	 (when (and (symbolp object)
+		    (special-operator-p object))
+	   (error 'simple-type-error
+		  :datum object
+		  :expected-type '(not (satisfies special-operator-p))
+		  :format-control "~S is a special operator."
+		  :format-arguments (list object)))		 
 	 (eval `#',object))
 	((numberp object)
 	 (let ((res
@@ -891,27 +977,29 @@
 	     (vector-to-list* object)
 	     (coerce-error)))
 	((csubtypep type (specifier-type 'string))
+	 (check-result
 	 (typecase object
 	   (list (list-to-string* object))
 	   (string (string-to-simple-string* object))
 	   (vector (vector-to-string* object))
 	   (t
-	    (coerce-error))))
+	     (coerce-error)))))
 	((csubtypep type (specifier-type 'bit-vector))
+	 (check-result
 	 (typecase object
 	   (list (list-to-bit-vector* object))
 	   (vector (vector-to-bit-vector* object))
 	   (t
-	    (coerce-error))))
+	     (coerce-error)))))
 	((csubtypep type (specifier-type 'vector))
+	 (check-result
 	 (typecase object
 	   (list (list-to-vector* object output-type-spec))
 	   (vector (vector-to-vector* object output-type-spec))
 	   (t
-	    (coerce-error))))
+	     (coerce-error)))))
 	(t
 	 (coerce-error))))))
-
 
 ;;; Internal Frobs:
 
Index: src//code/sort.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/sort.lisp,v
retrieving revision 1.7
diff -u -b -r1.7 sort.lisp
--- src//code/sort.lisp	1998/11/27 22:17:04	1.7
+++ src//code/sort.lisp	1999/09/06 01:27:30
@@ -437,6 +437,9 @@
 	     (result (make-sequence-of-type result-type (+ length-1 length-2))))
 	(declare (vector vector-1 vector-2)
 		 (fixnum length-1 length-2))
+
+	#+high-security
+	(check-type-var result result-type)
 	(if (and (simple-vector-p result)
 		 (simple-vector-p vector-1)
 		 (simple-vector-p vector-2))
Index: src//code/stream.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/stream.lisp,v
retrieving revision 1.39
diff -u -b -r1.39 stream.lisp
--- src//code/stream.lisp	1999/02/11 12:17:58	1.39
+++ src//code/stream.lisp	1999/09/06 01:27:30
@@ -180,6 +180,13 @@
 
 (defun input-stream-p (stream)
   "Returns non-nil if the given Stream can perform input operations."
+  (declare (type stream stream))
+
+  #+high-security
+  (when (synonym-stream-p stream)
+    (setf stream (symbol-value
+		  (synonym-stream-symbol stream))))
+  
   (and (lisp-stream-p stream)
        (not (eq (lisp-stream-in stream) #'closed-flame))
        (or (not (eq (lisp-stream-in stream) #'ill-in))
@@ -187,6 +194,13 @@
 
 (defun output-stream-p (stream)
   "Returns non-nil if the given Stream can perform output operations."
+  (declare (type stream stream))
+
+  #+high-security
+  (when (synonym-stream-p stream)
+    (setf stream (symbol-value
+		  (synonym-stream-symbol stream))))
+  
   (and (lisp-stream-p stream)
        (not (eq (lisp-stream-in stream) #'closed-flame))
        (or (not (eq (lisp-stream-out stream) #'ill-out))
@@ -253,6 +267,15 @@
     (let ((res (funcall (lisp-stream-misc stream) stream :file-position nil)))
       (when res (- res (- in-buffer-length (lisp-stream-in-index stream))))))))
 
+;;; declaration test functions
+
+#+high-security
+(defun stream-associated-with-file (stream)
+  "Tests if the stream is associated with a file"
+  (or (typep stream 'file-stream)
+      (and (synonym-stream-p stream)
+	   (typep (symbol-value (synonym-stream-symbol stream))
+		  'file-stream))))
 
 ;;; File-Length  --  Public
 ;;;
@@ -260,7 +283,12 @@
 ;;;
 (defun file-length (stream)
   "This function returns the length of the file that File-Stream is open to."
-  (declare (stream stream))
+  (declare (type (or file-stream synonym-stream) stream))
+
+  #+high-security
+  (check-type-var stream '(satisfies stream-associated-with-file)
+		  "A stream associated with a file")
+  
   (funcall (lisp-stream-misc stream) stream :file-length))
 
 
@@ -560,6 +588,19 @@
 (defun write-string (string &optional (stream *standard-output*)
 			    &key (start 0) (end (length (the vector string))))
   "Outputs the String to the given Stream."
+
+  #+high-security
+  (setf end (min end (length (the vector string))))
+  #+high-security
+  (setf start (max start 0))
+
+  #+high-security
+  (when (< end start)
+      (cerror "Continue with switched start and end ~s <-> ~s"
+	      "Write-string: start (~S) and end (~S) exchanged."
+	      start  end string)
+      (rotatef start end))
+    
   (write-string* string stream start end))
 
 (defun write-string* (string &optional (stream *standard-output*)
@@ -684,12 +725,28 @@
 				       (sout #'broadcast-sout)
 				       (misc #'broadcast-misc))
 			     (:print-function %print-broadcast-stream)
-			     (:constructor make-broadcast-stream (&rest streams)))
+			     (:constructor #-high-security-support
+					   make-broadcast-stream
+					   #+high-security-support
+					   %make-broadcast-stream (&rest streams)))
   ;; This is a list of all the streams we broadcast to.
   (streams () :type list :read-only t))
 
+#-high-security-support
 (setf (documentation 'make-broadcast-stream 'function)
  "Returns an ouput stream which sends its output to all of the given streams.")
+#+high-security-support
+(defun make-broadcast-stream (&rest streams)
+  "Returns an ouput stream which sends its output to all of the given streams."
+  (dolist (stream streams)    
+    (unless (or (and (synonym-stream-p stream)
+		     (output-stream-p (symbol-value
+				       (synonym-stream-symbol stream))))
+		(output-stream-p stream))
+      (error 'type-error
+	     :datum stream
+	     :expected-type '(satisfies output-stream-p))))
+  (apply #'%make-broadcast-stream streams))
 
 (defun %print-broadcast-stream (s stream d)
   (declare (ignore s d))
@@ -820,7 +877,10 @@
 		      (sout #'two-way-sout)
 		      (misc #'two-way-misc))
 	    (:print-function %print-two-way-stream)
-	    (:constructor make-two-way-stream (input-stream output-stream)))
+	    (:constructor #-high-security-support
+			  make-two-way-stream
+			  #+high-security-support
+			  %make-two-way-stream (input-stream output-stream)))
   ;; We read from this stream...
   (input-stream (required-argument) :type stream :read-only t)
   ;; And write to this one
@@ -832,9 +892,29 @@
 	  (two-way-stream-input-stream s)
 	  (two-way-stream-output-stream s)))
 
+#-high-security-support
 (setf (documentation 'make-two-way-stream 'function)
   "Returns a bidirectional stream which gets its input from Input-Stream and
    sends its output to Output-Stream.")
+#+high-security-support
+(defun make-two-way-stream (input-stream output-stream)
+  "Returns a bidirectional stream which gets its input from Input-Stream and
+   sends its output to Output-Stream."
+  (unless (or (and (synonym-stream-p output-stream)
+	 	   (output-stream-p (symbol-value
+				     (synonym-stream-symbol output-stream))))
+	      (output-stream-p output-stream))    
+    (error 'type-error 
+	   :datum output-stream
+	   :expected-type '(satisfies output-stream-p)))
+  (unless (or (and (synonym-stream-p input-stream)
+		   (input-stream-p (symbol-value
+				    (synonym-stream-symbol input-stream))))
+	      (input-stream-p input-stream))
+    (error 'type-error
+	   :datum input-stream
+	   :expected-type '(satisfies input-stream-p)))
+  (funcall #'%make-two-way-stream input-stream output-stream))
 
 (macrolet ((out-fun (name slot stream-method &rest args)
 	     `(defun ,name (stream ,@args)
@@ -898,7 +978,9 @@
 		      (misc #'concatenated-misc))
 	    (:print-function %print-concatenated-stream)
 	    (:constructor
-	     make-concatenated-stream (&rest streams &aux (current streams))))
+	     #-high-security-support make-concatenated-stream
+	     #+high-security-support %make-concatenated-stream 
+	         (&rest streams &aux (current streams))))
   ;; The car of this is the stream we are reading from now.
   current
   ;; This is a list of all the streams.  We need to remember them so that
@@ -910,10 +992,25 @@
   (format stream "#<Concatenated Stream, Streams = ~S>"
 	  (concatenated-stream-streams s)))
 
+#-high-security-support
 (setf (documentation 'make-concatenated-stream 'function)
   "Returns a stream which takes its input from each of the Streams in turn,
    going on to the next at EOF.")
 
+#+high-security-support
+(defun make-concatenated-stream (&rest streams)
+  "Returns a stream which takes its input from each of the Streams in turn,
+   going on to the next at EOF."
+  (dolist (stream streams)
+    (unless (or (and (synonym-stream-p stream)
+		     (input-stream-p (symbol-value
+				      (synonym-stream-symbol stream))))
+		(input-stream-p stream))    
+      (error 'type-error
+	     :datum stream
+	     :expected-type '(satisfies input-stream-p))))
+  (apply #'%make-concatenated-stream streams))
+
 (macrolet ((in-fun (name fun)
 	     `(defun ,name (stream eof-errorp eof-value)
 		(do ((current (concatenated-stream-current stream) (cdr current)))
@@ -1111,6 +1208,14 @@
   (declare (type string string)
 	   (type index start)
 	   (type (or index null) end))
+  
+  #+high-security
+  (when (> end (length string))
+    (cerror "Continue with end changed from ~s to ~s"
+	      "Write-string: end (~S) is larger then the length of the string (~S)"
+	      end (1- (length string)))
+     (setf end (1- (length string))))
+
   (internal-make-string-input-stream (coerce string 'simple-string)
 				     start end))
 
Index: src//code/sysmacs.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/code/sysmacs.lisp,v
retrieving revision 1.23
diff -u -b -r1.23 sysmacs.lisp
--- src//code/sysmacs.lisp	1998/07/28 06:56:32	1.23
+++ src//code/sysmacs.lisp	1999/09/06 01:27:30
@@ -97,6 +97,13 @@
        (cond ((null ,svar) *standard-input*)
 	     ((eq ,svar t) *terminal-io*)
 	     (T ,@(if check-type `((check-type ,svar ,check-type)))
+		#+high-security
+		(unless (input-stream-p ,svar)
+		  (error 'simple-type-error
+			 :datum ,svar
+			 :expected-type '(satisfies input-stream-p)
+			 :format-control "~S isn't an input stream"
+			 :format-arguments ,(list  svar)))		
 		,svar)))))
 
 (defmacro out-synonym-of (stream &optional check-type)
@@ -105,6 +112,13 @@
        (cond ((null ,svar) *standard-output*)
 	     ((eq ,svar t) *terminal-io*)
 	     (T ,@(if check-type `((check-type ,svar ,check-type)))
+		#+high-security
+		(unless (output-stream-p ,svar)
+		  (error 'simple-type-error
+			 :datum ,svar
+			 :expected-type '(satisfies output-stream-p)
+			 :format-control "~S isn't an output stream"
+			 :format-arguments ,(list  svar)))
 		,svar)))))
 
 ;;; With-Mumble-Stream calls the function in the given Slot of the
Index: src//compiler/loadbackend.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/compiler/loadbackend.lisp,v
retrieving revision 1.9
diff -u -b -r1.9 loadbackend.lisp
--- src//compiler/loadbackend.lisp	1994/10/31 04:27:28	1.9
+++ src//compiler/loadbackend.lisp	1999/09/06 01:27:30
@@ -54,6 +54,12 @@
 (load "vm:pred")
 (load "vm:type-vops")
 
+(when (target-featurep :direct-syscall)
+  (cond ((target-featurep :freebsd)
+         (load "vm:syscall-freebsd"))
+        ((target-featurep :linux)
+         (load "vm:syscall-linux"))))
+
 (load "assem:assem-rtns")
 
 (load "assem:array")
Index: src//compiler/proclaim.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/compiler/proclaim.lisp,v
retrieving revision 1.30
diff -u -b -r1.30 proclaim.lisp
--- src//compiler/proclaim.lisp	1994/10/31 04:27:28	1.30
+++ src//compiler/proclaim.lisp	1999/09/06 01:27:30
@@ -62,8 +62,12 @@
 ;;; 
 (defun proclaim-init ()
   (setf *default-cookie*
+	#-high-security
 	(make-cookie :safety 1 :speed 1 :space 1 :cspeed 1
-		     :brevity 1 :debug 2))
+		     :brevity 1 :debug 2)
+	#+high-security
+	(make-cookie :safety 3 :speed 0 :space 0 :cspeed 0
+		     :brevity 0 :debug 3))
   (setf *default-interface-cookie*
 	(make-cookie)))
 ;;;
Index: src//docs/cmu-user/cmu-user.tex
===================================================================
RCS file: /home/CVS-cmucl/src/docs/cmu-user/cmu-user.tex,v
retrieving revision 1.12
diff -u -b -r1.12 cmu-user.tex
--- src//docs/cmu-user/cmu-user.tex	2000/01/14 20:03:57	1.12
+++ src//docs/cmu-user/cmu-user.tex	2000/01/24 22:36:38
@@ -32,7 +32,7 @@
 \usepackage{verbatim}
 \usepackage{ifthen}
 \usepackage{calc}
-\usepackage{html2}
+\usepackage{html}
 \usepackage{varioref}
 
 %% Define the indices.  We need one for Types, Variables, Functions,
Index: src//docs/interface/internals.tex
===================================================================
RCS file: /home/CVS-cmucl/src/docs/interface/internals.tex,v
retrieving revision 1.1
diff -u -b -r1.1 internals.tex
--- src//docs/interface/internals.tex	1997/12/28 18:03:24	1.1
+++ src//docs/interface/internals.tex	1999/09/06 01:27:30
@@ -4,7 +4,7 @@
 %% LaTeX formatting by Marco Antoniotti based on internals.doc.
 
 \documentclass{article}
-\usepackage{a4wide}
+%\usepackage{a4wide}
 
 \title{General Design Notes on the Motif Toolkit Interface}
 
Index: src//docs/interface/toolkit.tex
===================================================================
RCS file: /home/CVS-cmucl/src/docs/interface/toolkit.tex,v
retrieving revision 1.1
diff -u -b -r1.1 toolkit.tex
--- src//docs/interface/toolkit.tex	1997/12/28 18:06:25	1.1
+++ src//docs/interface/toolkit.tex	1999/09/06 01:27:30
@@ -4,7 +4,7 @@
 %% LaTeX formatting by Marco Antoniotti based on internals.doc.
 
 \documentclass{article}
-\usepackage{a4wide}
+%\usepackage{a4wide}
 
 
 \newcommand{\functdescr}[1]{\paragraph{\texttt{#1}}}
Index: src//hemlock/main.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/hemlock/main.lisp,v
retrieving revision 1.14
diff -u -b -r1.14 main.lisp
--- src//hemlock/main.lisp	1994/10/31 04:50:12	1.14
+++ src//hemlock/main.lisp	2000/02/04 13:57:36
@@ -31,6 +31,8 @@
 
 (defvar *hemlock-version* "3.5")
 (pushnew :hemlock *features*)
+(setf *features* (remove :no-hemlock *features*))
+
 (setf (getf ext:*herald-items* :hemlock) 
       `("    Hemlock " ,*hemlock-version*))
 
@@ -283,7 +285,57 @@
 	 (invoke-hook (reverse *after-editor-initializations-funs*)))
        (catch 'hemlock-exit
 	 (catch 'editor-top-level-catcher
-	   (cond ((and x (symbolp x))
+	   (cond ((and x
+		       (symbolp x)
+		       (fboundp x))
+		  (let* ((function (symbol-function x))
+			 (code-header
+			  #+cmu
+			  (case (kernel:get-type function)
+			    (#.vm:closure-header-type
+			     (kernel:function-code-header
+			      (%closure-function function)))
+			    ((#.vm:function-header-type #.vm:closure-function-header-type)
+			     (kernel:function-code-header
+			      function))
+			    (#.vm:funcallable-instance-header-type
+			     (typecase x
+			       (kernel:byte-function
+				(c::byte-function-component function))
+			       (kernel:byte-closure
+				(c::byte-function-component
+				 (byte-closure-function function)))))))
+			 (code-info
+			  (when code-header
+			    (kernel:%code-debug-info code-header)))
+			 (sources
+			  (when code-info
+			    (c::debug-info-source code-info))))
+		    (if sources
+			(loop for source in sources
+			  do
+			  (let* ((filep
+				  (eq
+				   (c::debug-source-from (first sources))
+				   :file))
+				 (file-name
+				  (when sources
+				    (let ((results ()))
+				      (enumerate-search-list
+				       (file
+					(c::debug-source-name (first sources)))
+				       (push file results))
+				      (when results
+					(first results)))))
+				 (buffer
+				  (when (and filep file-name)
+				    (ed::find-file-buffer file-name)))
+				 (*print-case* :downcase))
+			    (when buffer
+			      (ed::change-to-buffer buffer)
+			      ;; we should search for the definition...
+			      (buffer-start (buffer-point buffer)))))
+			(when function
 		  (let* ((name (nstring-capitalize
 				(concatenate 'simple-string "Edit " (string x))))
 			 (buffer (or (getstring name *buffer-names*)
@@ -292,10 +344,11 @@
 		    (delete-region (buffer-region buffer))
 		    (with-output-to-mark
 			(*standard-output* (buffer-point buffer))
-		      (eval `(grindef ,x))	; hackish, I know...
+			   (pprint 
+			    (function-lambda-expression function))
 		      (terpri)
 		      (ed::change-to-buffer buffer)
-		      (buffer-start (buffer-point buffer)))))
+			   (buffer-start (buffer-point buffer))))))))
 		 ((or (stringp x) (pathnamep x))
 		  (ed::find-file-command () x))
 		 (x
Index: src//interface/initial.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/interface/initial.lisp,v
retrieving revision 1.5
diff -u -b -r1.5 initial.lisp
--- src//interface/initial.lisp	1994/10/31 04:53:18	1.5
+++ src//interface/initial.lisp	1999/09/06 01:27:30
@@ -12,6 +12,7 @@
 (in-package "USER")
 
 (pushnew :motif *features*)
+(setf *features* (remove :no-clm *features*))
 
 (setf (getf ext:*herald-items* :motif)
       `("    Motif toolkit and graphical debugger 1.0"))
Index: src//lisp/Config.linux_gencgc
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/Config.linux_gencgc,v
retrieving revision 1.3
diff -u -b -r1.3 Config.linux_gencgc
--- src//lisp/Config.linux_gencgc	1998/12/20 04:21:28	1.3
+++ src//lisp/Config.linux_gencgc	2000/01/24 21:44:39
@@ -1,7 +1,8 @@
-vpath %.h /usr/src/cmucl/cmucl/src/lisp/
-vpath %.c /usr/src/cmucl/cmucl/src/lisp/
-vpath %.S /usr/src/cmucl/cmucl/src/lisp/
-CPPFLAGS = -I. -I/usr/src/cmucl/cmucl/src/lisp/ -I- -I/usr/X11R6/include
+vpath %.h ../../src/lisp/
+vpath %.c ../../src/lisp/
+vpath %.S ../../src/lisp/
+CPPFLAGS = -I. -I../../src/lisp/ -I- -I/usr/X11R6/include
+#CC = gcc -fno-strict-aliasing -Wstrict-prototypes -O2 -fno-strength-reduce # -Wall
 CC = gcc  -Wstrict-prototypes -O2 -fno-strength-reduce # -Wall
 LD = ld
 CPP = cpp
@@ -13,5 +14,6 @@
 ARCH_SRC = x86-arch.c
 OS_SRC = Linux-os.c os-common.c
 OS_LINK_FLAGS=
+# -static
 OS_LIBS= -ldl
 GC_SRC= gencgc.c
Index: src//lisp/GNUmakefile
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/GNUmakefile,v
retrieving revision 1.13
diff -u -b -r1.13 GNUmakefile
--- src//lisp/GNUmakefile	1997/06/07 15:25:37	1.13
+++ src//lisp/GNUmakefile	1999/09/06 01:27:30
@@ -25,12 +25,12 @@
 
 lisp.nm: lisp
 	echo 'Map file for lisp version ' `cat version` > ,lisp.nm
-	$(NM) lisp | grep -v " F \| U " >> ,lisp.nm
+	$(NM) lisp | grep " t \| T \| D \| B " | grep -v "gcc_compiled\|Letext" >> ,lisp.nm
 	mv ,lisp.nm lisp.nm
 
 lisp: version.c ${OBJS} version
-	echo '1 + ' `cat version` | bc > ,version
-	mv ,version version
+	echo '1 + ' `cat version` | bc | tail -n 1 | sed "s/
//g" > ,version
+	mv -f ,version version
 	$(CC) ${CFLAGS} -DVERSION=`cat version` -c $<
 	$(CC) -g ${OS_LINK_FLAGS} -o ,lisp \
 		${OBJS} version.o \
@@ -49,10 +49,11 @@
 	@false
 
 clean:
-	rm -f Depends *.o lisp lisp.nm core
+	rm -f Depends *.o lisp lisp.nm core ; true
+	touch Depends
 
 depend: ${SRCS}
 	$(CC) -MM -E ${DEPEND_FLAGS} ${CFLAGS} ${CPPFLAGS} $? > ,depends
-	mv ,depends Depends
+	mv -f ,depends Depends
 
 include Depends
Index: src//lisp/Linux-os.c
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/Linux-os.c,v
retrieving revision 1.10
diff -u -b -r1.10 Linux-os.c
--- src//lisp/Linux-os.c	2000/01/19 18:15:15	1.10
+++ src//lisp/Linux-os.c	2000/01/24 21:41:16
@@ -63,7 +63,9 @@
 }
 #endif
 
+static has_mmap_tuning=0;
 
+
 void os_init(void)
 {
   struct utsname name;
@@ -73,9 +75,19 @@
   /* We need this for mmap */
 
   if (name.release[0] < '2')
+   {
+    printf("Linux version should be later than 2.0.0!\n");
+    printf("Dazed and confused but trying to continue...\n");
+    has_mmap_tuning=0;
+   }
+ else 
+   {
+     if (((name.release[0]) > '2') ||
+	 (((name.release[0]) == '2') && ((name.release[2]) >= '1')))
    {
-    printf("Linux version must be later then 2.0.0!\n");
-    exit(2);
+	 DPRINTF(0,(stderr,"has mman tuning\n"));
+	 has_mmap_tuning=1;
+       }
   }
 
   os_vm_page_size = getpagesize();
@@ -118,33 +130,123 @@
 {
 }
 
-os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len)
+int do_mmap(os_vm_address_t *addr, os_vm_size_t len, int flags)
 {
-  int flags = MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE;
+  /* We _must_ have the memory where we want it... */
+  os_vm_address_t old_addr = *addr;
 
-  if (addr)
-    flags |= MAP_FIXED;
+  DPRINTF(0,(stderr,"do_mmap: %x->%x %x\n",*addr,(*addr)+len, flags));
+  
+  *addr = mmap(*addr, len, OS_VM_PROT_ALL, flags, -1, 0);
+  if ((old_addr != NULL && *addr != old_addr) || 
+      *addr == (os_vm_address_t) -1)
+    {
+      if (has_mmap_tuning)
+	fprintf(stderr, "Error in allocating memory
+
+CMUCL asks the kernel to make a lot of memory potentially available.
+Truely a lot of memory, actually it asks for all memory a process
+can allocate.
+
+Now you have two choices:
+ - Accept this and lift the kernel and other limits by doing:
+ as root:
+ echo 1 > /proc/sys/vm/overcommit_memory
+ as the user:
+ ulimit -d unlimited 
+ ulimit -v unlimited 
+ ulimit -m unlimited 
+
+  - Try to use the lazy-allocation routines. They are pretty experimental
+ and might interact badly with some kernels. To do this start lisp with the
+ \"-lazy\" flag, like:
+ lisp -lazy
+
+");
   else
-    flags |= MAP_VARIABLE;
+	fprintf(stderr, "Error in allocating memory, do you have more than 16MB of memory+swap?\n");
+      perror("mmap");
+      return 1;
+    }
+ return 0;
+}
 
-  DPRINTF(0, (stderr, "os_validate %x %d => ", addr, len));
+static boolean in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
+{
+  char* beg = (char*) sbeg;
+  char* end = (char*) sbeg + slen;
+  char* adr = (char*) a;
+  return (adr >= beg && adr < end);
+}
 
-  addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0);
+os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len)
+{
+  int flags = MAP_PRIVATE | MAP_ANONYMOUS;
 
-  if(addr == (os_vm_address_t) -1)
+  if (lazy_memory_allocation == 1)
     {
-      perror("mmap");
-      return NULL;
+      switch((unsigned long) addr) 
+	{
+	case READ_ONLY_SPACE_START: 
+	  DPRINTF(0,(stderr,
+		  "It's readonly space... ignoring request for memory\n")); 
+	  return addr;
+	case STATIC_SPACE_START: 
+	  DPRINTF(0,(stderr,
+		  "It's static space... ignoring request for memory\n")); 
+	  return addr;
+	case BINDING_STACK_START: 
+	  DPRINTF(0,(stderr,
+		  "It's the binding stack... ignoring request for memory\n")); 
+	  return addr;
+	case CONTROL_STACK_START: 
+	  DPRINTF(0,(stderr,"It's the control stack %x->%x %x\n",addr, 
+		     (os_vm_address_t) (((unsigned long) addr + len)), flags));  
+	  flags |= MAP_GROWSDOWN; 
+	  addr = (os_vm_address_t) (((unsigned long) addr + len - 4096) & ~0xFFF);
+	  len = 4096;
+	  break;
+	case DYNAMIC_0_SPACE_START:  
+	  {
+	    int start_page = find_page_index( (void *) addr);
+	    int number_of_pages = len / 4096;
+	    int page;
+	    
+	    DPRINTF(0,(stderr,
+		       "It's dynamic 0 space...ignoring request for memory\n"));  
+	    
+	    DPRINTF(0,(stderr,"start: %i number: %i\n",
+		       start_page, number_of_pages));
+	    // clean the allocate mask;
+	    for(page = 0; page <= number_of_pages; page++)
+	      page_table[page+ start_page].flags 
+		&= ~PAGE_LAZY_ALLOCATE_MASK;
     }
+	  return addr; 
+	}
+    }
+  else
+    flags |= MAP_NORESERVE;
+  /* Try to avoid turning on overcommit globally */
 
-  DPRINTF(0, (stderr, "%x\n", addr));
+  if (addr)
+    flags |= MAP_FIXED;
+  else
+    flags |= MAP_VARIABLE;
 
+  DPRINTF(0, (stderr, "os_validate %x ->  %x %x => ", addr, addr+len, flags));
+  if (do_mmap(&addr, len, flags))
+    return NULL;
+  else
+    {
+      DPRINTF(0, (stderr, "%x\n", addr));
   return addr;
+    }
 }
 
 void os_invalidate(os_vm_address_t addr, os_vm_size_t len)
 {
-  DPRINTF(0, (stderr, "os_invalidate %x %d\n", addr, len));
+  DPRINTF(0, (stderr, "os_invalidate %x -> %x\n", addr, addr+len));
 
   if (munmap(addr, len) == -1)
     perror("munmap");
@@ -153,11 +255,29 @@
 os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr,
 		       os_vm_size_t len)
 {
+  DPRINTF(0,(stderr,"os map: %i %x %x -> %x\n", fd, offset, addr, addr+len));
+
+  if ((lazy_memory_allocation == 1) &&
+      in_range_p((os_vm_address_t) addr, 
+		 DYNAMIC_0_SPACE_START, DYNAMIC_SPACE_SIZE))
+    {
+      int start_page = find_page_index( (void *) addr);
+      int number_of_pages = len / 4096;
+      int page;
+	    
+      // clean the allocate mask;
+      for(page = 0; page <= number_of_pages; page++)
+	page_table[page+ start_page].flags 
+	  &= ~PAGE_LAZY_ALLOCATE_MASK;
+    }
+  
   addr = mmap(addr, len,
 	      OS_VM_PROT_ALL,
 	      MAP_PRIVATE | MAP_FILE | MAP_FIXED,
 	      fd, (off_t) offset);
-
+  DPRINTF(0,(stderr,"osmap: %x -> %x\n",
+	  (unsigned long) addr,
+	  (unsigned long) (addr+len)));
   if (addr == (os_vm_address_t) -1)
     perror("mmap");
 
@@ -171,19 +291,16 @@
 void os_protect(os_vm_address_t address, os_vm_size_t length,
 		os_vm_prot_t prot)
 {
+  /* make certain the page is already mapped! */
+ if ( ! ((lazy_memory_allocation == 1) &&
+		 in_range_p(address, DYNAMIC_0_SPACE_START, DYNAMIC_SPACE_SIZE) &&
+    PAGE_LAZY_ALLOCATE(find_page_index((void *) address)) == 0))
   if (mprotect(address, length, prot) == -1)
     perror("mprotect");
 }
 
 
 
-static boolean in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen)
-{
-  char* beg = (char*) sbeg;
-  char* end = (char*) sbeg + slen;
-  char* adr = (char*) a;
-  return (adr >= beg && adr < end);
-}
 
 boolean valid_addr(os_vm_address_t addr)
 {
@@ -194,7 +311,9 @@
   if (   in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE)
       || in_range_p(addr, STATIC_SPACE_START   , STATIC_SPACE_SIZE   )
       || in_range_p(addr, DYNAMIC_0_SPACE_START, DYNAMIC_SPACE_SIZE  )
+#ifndef GENCGC
       || in_range_p(addr, DYNAMIC_1_SPACE_START, DYNAMIC_SPACE_SIZE  )
+#endif
       || in_range_p(addr, CONTROL_STACK_START  , CONTROL_STACK_SIZE  )
       || in_range_p(addr, BINDING_STACK_START  , BINDING_STACK_SIZE  ))
     return TRUE;
@@ -211,19 +330,95 @@
   int  fault_addr = ((struct sigcontext_struct *) (&contextstruct))->cr2;
   int  page_index = find_page_index((void *) fault_addr);
 
+  /* First we see if it is because of the lazy-allocation magic... */
+
+  if (lazy_memory_allocation == 1)
+    {
+      if (in_range_p((os_vm_address_t) fault_addr, 
+		     READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE))
+	{
+	  DPRINTF(0,(stderr,"mapping read-only page in at %x\n",fault_addr));
+	  fault_addr &= 0xFFFFF000L;
+	  if (do_mmap((os_vm_address_t *) &fault_addr, 4096, 
+		      MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED))
+	    perror("map failed");	  
+	  return;
+	}
+      else
+	if (in_range_p((os_vm_address_t) fault_addr, 
+		       STATIC_SPACE_START, STATIC_SPACE_SIZE))
+	  {
+	    DPRINTF(0,(stderr,"mapping static page in at %x\n",fault_addr));
+	    fault_addr &= 0xFFFFF000L;
+	    if (do_mmap((os_vm_address_t *) &fault_addr, 4096, 
+			MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED))
+	      perror("map failed");	  
+	    return;
+	  }
+      else
+	if (in_range_p((os_vm_address_t) fault_addr, 
+		       BINDING_STACK_START, BINDING_STACK_SIZE))
+	  {
+	    DPRINTF(0,(stderr,"mapping binding stack page in at %x\n",
+		    fault_addr));
+	    fault_addr &= 0xFFFFF000L;
+	    if (do_mmap((os_vm_address_t *) &fault_addr, 4096, 
+			MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED))
+	      perror("map failed");	  
+	    return;
+	  }
+      else
+	if (in_range_p((os_vm_address_t) fault_addr, 
+		       CONTROL_STACK_START, CONTROL_STACK_SIZE))
+	  {
+	    DPRINTF(0,(stderr,"mapping control stack page in at %x\n",
+		    fault_addr));
+	    fault_addr &= 0xFFFFF000L;
+	    if (do_mmap((os_vm_address_t *) &fault_addr, 4096, 
+			MAP_GROWSDOWN | MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED))
+	      perror("map failed");	  
+	    return;
+	  }
+    }
+      
   /* Check if the fault is within the dynamic space. */
   if (page_index != -1) {
     /* Un-protect the page */
 
+    if ((lazy_memory_allocation == 1) &&
+	(PAGE_LAZY_ALLOCATE(page_index) == 0))
+      {
+	DPRINTF(0,(stderr,"mapping dynamic space page in at %x %i\n",
+		fault_addr,PAGE_WRITE_PROTECTED(page_index)));
+	fault_addr &= 0xFFFFF000L;
+	if (do_mmap((os_vm_address_t *) &fault_addr, 4096, 
+		    MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED))
+	  perror("map failed");	  
+        
+	page_table[page_index].flags |= PAGE_LAZY_ALLOCATE_MASK;
+
+	if (PAGE_WRITE_PROTECTED(page_index))
+	  os_protect(page_address(page_index), 4096, OS_VM_PROT_READ | OS_VM_PROT_EXECUTE);
+	
+	return;
+      }
+    else    
+    {
     /* The page should have been marked write protected */
     if (!PAGE_WRITE_PROTECTED(page_index))
-      fprintf(stderr, "*** Sigsegv in page not marked as write protected\n");
+	  fprintf(stderr, 
+		  "*** Sigsegv in page not marked as write protected: %x %i %x %i\n",
+		  fault_addr,lazy_memory_allocation,
+		  page_table[page_index].flags,
+		  page_table[page_index].flags & PAGE_LAZY_ALLOCATE_MASK);
+
     os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL);
     page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK;
     page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK;
 
     return;
   }
+  }
 
   DPRINTF(0,(stderr,"sigsegv: eip: %p\n",context->eip));
   interrupt_handle_now(signal, contextstruct);
@@ -249,7 +444,7 @@
     context->sc_regs[reg_ALLOC] -= (1 << 63);
     interrupt_handle_pending(context);
   } else if (addr > CONTROL_STACK_TOP && addr < BINDING_STACK_START) {
-    fprintf(stderr, "Possible stack overflow at 0x%08lX!\n", addr);
+    DPRINTF(0,(stderr, "Possible stack overflow at 0x%08lX!\n", addr));
     /* try to fix control frame pointer */
     while (!(CONTROL_STACK_START <= *current_control_frame_pointer &&
 	     *current_control_frame_pointer <= CONTROL_STACK_TOP))
@@ -267,7 +462,7 @@
   GET_CONTEXT
 #endif
 
-  DPRINTF(1, (stderr, "sigbus:\n")); /* there is no sigbus in linux??? */
+  DPRINTF(0, (stderr, "sigbus:\n")); /* there is no sigbus in linux??? */
 #ifdef i386
   interrupt_handle_now(signal, contextstruct);
 #else
Index: src//lisp/Linux-os.h
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/Linux-os.h,v
retrieving revision 1.11
diff -u -b -r1.11 Linux-os.h
--- src//lisp/Linux-os.h	1999/09/22 14:42:08	1.11
+++ src//lisp/Linux-os.h	2000/01/24 21:41:29
@@ -110,3 +110,7 @@
 #ifndef sa_sigaction
 #define sa_sigaction	sa_handler
 #endif
+
+#ifndef MAP_NORESERVE
+#define MAP_NORESERVE   0x4000
+#endif
Index: src//lisp/backtrace.c
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/backtrace.c,v
retrieving revision 1.4
diff -u -b -r1.4 backtrace.c
--- src//lisp/backtrace.c	1994/10/25 17:31:52	1.4
+++ src//lisp/backtrace.c	1999/12/14 21:12:57
@@ -245,9 +245,7 @@
 
 #else
 
-void
-backtrace(nframes)
-int nframes;
+void backtrace(int nframes)
 {
     printf("Can't backtrace on this hardware platform.\n");
 }
Index: src//lisp/coreparse.c
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/coreparse.c,v
retrieving revision 1.6
diff -u -b -r1.6 coreparse.c
--- src//lisp/coreparse.c	1997/03/16 15:52:51	1.6
+++ src//lisp/coreparse.c	1999/09/06 01:27:30
@@ -87,6 +87,10 @@
 
     if (fd < 0) {
 	fprintf(stderr, "Could not open file \"%s\".\n", file);
+#ifdef __linux__
+	if (strcmp(file,"/usr/lib/cmucl/lisp.core") == 0)
+	   fprintf(stderr, "Maybe you should run cmuclconfig?\n");
+#endif
 	perror("open");
 	exit(1);
     }
Index: src//lisp/gencgc.c
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/gencgc.c,v
retrieving revision 1.18
diff -u -b -r1.18 gencgc.c
--- src//lisp/gencgc.c	2000/01/19 18:09:16	1.18
+++ src//lisp/gencgc.c	2000/01/19 21:04:29
@@ -6205,6 +6205,7 @@
   for (i = 0; i < NUM_PAGES; i++) {
     /* Initial all pages as free. */
     page_table[i].flags &= ~PAGE_ALLOCATED_MASK;
+
     page_table[i].bytes_used = 0;
 
     /* Pages are not write protected at startup. */
@@ -6267,6 +6268,7 @@
   /* Initialise the first region. */
   do {
     page_table[page].flags |= PAGE_ALLOCATED_MASK;
+
     page_table[page].flags &= ~(PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK
 				| PAGE_LARGE_OBJECT_MASK);
     page_table[page].bytes_used = PAGE_SIZE;
Index: src//lisp/gencgc.h
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/gencgc.h,v
retrieving revision 1.3
diff -u -b -r1.3 gencgc.h
--- src//lisp/gencgc.h	2000/01/09 19:36:08	1.3
+++ src//lisp/gencgc.h	2000/01/11 20:02:11
@@ -80,6 +80,16 @@
 	(PAGE_LARGE_OBJECT(page) >> PAGE_LARGE_OBJECT_SHIFT)
 
 /*
+ * If there is already memory allocated for this page or not.
+ * Should be 0 when it is unallocated and 1 if it is allocated.
+ *
+ */
+
+#define PAGE_LAZY_ALLOCATE_MASK		0x00000400
+#define PAGE_LAZY_ALLOCATE(page) \
+        (page_table[page].flags & PAGE_LAZY_ALLOCATE_MASK)
+
+/*
  * The generation that this page belongs to. This should be valid for
  * all pages that may have objects allocated, even current allocation
  * region pages - this allows the space of an object to be easily
Index: src//lisp/globals.h
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/globals.h,v
retrieving revision 1.4
diff -u -b -r1.4 globals.h
--- src//lisp/globals.h	1997/01/21 00:28:13	1.4
+++ src//lisp/globals.h	1999/12/09 18:53:10
@@ -9,6 +9,8 @@
 
 extern int foreign_function_call_active;
 
+extern boolean lazy_memory_allocation;
+
 extern lispobj *current_control_stack_pointer;
 extern lispobj *current_control_frame_pointer;
 #if !defined(ibmrt) && !defined(i386)
Index: src//lisp/lisp.c
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/lisp.c,v
retrieving revision 1.16
diff -u -b -r1.16 lisp.c
--- src//lisp/lisp.c	1999/09/09 16:22:44	1.16
+++ src//lisp/lisp.c	1999/12/14 21:12:05
@@ -83,8 +83,9 @@
 
 
 /* And here be main. */
+boolean lazy_memory_allocation;
 
-void main(int argc, char *argv[], char *envp[])
+int main(int argc, char *argv[], char *envp[])
 {
     char *arg, **argptr;
     char *core = NULL, *default_core;
@@ -102,6 +103,7 @@
 
     monitor = FALSE;
 
+    lazy_memory_allocation = 0;
     argptr = argv;
     while ((arg = *++argptr) != NULL) {
         if (strcmp(arg, "-core") == 0) {
@@ -115,6 +117,10 @@
                 exit(1);
             }
         }
+	else if (strcmp(arg, "-lazy") == 0) {
+	  fprintf(stderr,"Using lazy memory allocation...\n");      
+	  lazy_memory_allocation = 1;
+	}
 	else if (strcmp(arg, "-monitor") == 0) {
 	    monitor = TRUE;
 	}
Index: src//lisp/socket.c
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/socket.c,v
retrieving revision 1.3
diff -u -b -r1.3 socket.c
--- src//lisp/socket.c	1994/10/27 17:13:54	1.3
+++ src//lisp/socket.c	1999/12/14 21:15:23
@@ -31,8 +31,10 @@
 
 #include "os.h"
 
+#ifndef __linux__
 extern int errno;		/* Certain (broken) OS's don't have this */
 				/* decl in errno.h */
+#endif
 
 #ifdef UNIXCONN
 #include <sys/un.h>
@@ -45,6 +47,9 @@
 #endif /* hpux */
 #endif /* X_UNIX_PATH */
 #endif /* UNIXCONN */
+#ifdef __linux__
+#include <string.h>
+#endif
 #ifndef bcopy
 void bcopy();
 #endif
@@ -54,9 +59,7 @@
  * descriptor (network socket) or 0 if connection fails.
  */
 
-int connect_to_server (host, display)
-     char *host;
-     int display;
+int connect_to_server (char *host, int display)
 {
   struct sockaddr_in inaddr;	/* INET socket address. */
   struct sockaddr *addr;		/* address to connect to */
Index: src//lisp/x86-arch.c
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/x86-arch.c,v
retrieving revision 1.11
diff -u -b -r1.11 x86-arch.c
--- src//lisp/x86-arch.c	1999/11/11 16:14:16	1.11
+++ src//lisp/x86-arch.c	1999/12/14 21:16:11
@@ -274,8 +274,8 @@
 #define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2)
 
 extern void first_handler();
-void 
-arch_install_interrupt_handlers()
+
+void arch_install_interrupt_handlers()
 {
     interrupt_install_low_level_handler(SIGILL ,sigtrap_handler);
     interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler);
Index: src//lisp/x86-validate.h
===================================================================
RCS file: /home/CVS-cmucl/src/lisp/x86-validate.h,v
retrieving revision 1.11
diff -u -b -r1.11 x86-validate.h
--- src//lisp/x86-validate.h	1999/09/16 15:40:11	1.11
+++ src//lisp/x86-validate.h	1999/09/06 01:27:30
@@ -70,7 +70,8 @@
 
 #define DYNAMIC_0_SPACE_START	(0x48000000)
 #ifdef GENCGC
-#define DYNAMIC_SPACE_SIZE	(0x20000000) /* 512MB */
+// #define DYNAMIC_SPACE_SIZE	(0x20000000) /* 512MB */
+#define DYNAMIC_SPACE_SIZE	(0x70000000) /* 1.75 GB */
 #else
 #define DYNAMIC_SPACE_SIZE	(0x04000000) /* 64MB */
 #endif
Index: src//motif/server/Config.x86
===================================================================
RCS file: /home/CVS-cmucl/src/motif/server/Config.x86,v
retrieving revision 1.2
diff -u -b -r1.2 Config.x86
--- src//motif/server/Config.x86	1997/04/19 20:13:23	1.2
+++ src//motif/server/Config.x86	1999/09/06 01:27:30
@@ -1,6 +1,8 @@
 CFLAGS = -O2 -I/usr/X11R6/include -I. -I$(VPATH)
 LDFLAGS = -L/usr/X11R6/lib
-LIBS = -static -lXm -dynamic -lXt -lXext -lX11 -lSM -lICE
+# -L/usr/lib/libc5-compat/
+LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE 
+# -static
 # This def assumes you are building in the same or parallel
 # tree to the CVS souce layout. Sites may need to customize
 # this path.
Index: src//motif/server/GNUmakefile
===================================================================
RCS file: /home/CVS-cmucl/src/motif/server/GNUmakefile,v
retrieving revision 1.4
diff -u -b -r1.4 GNUmakefile
--- src//motif/server/GNUmakefile	1997/01/18 14:31:43	1.4
+++ src//motif/server/GNUmakefile	1999/09/06 01:27:30
@@ -1,7 +1,7 @@
-CC = gcc
+#CC=i486-linuxlibc1-gcc
+CC=gcc
 LIBS = -lXm -lXt -lX11
 CFLAGS = -O
-LDFLAGS =
 
 TARGET = motifd
 OBJS = main.o server.o translations.o packet.o message.o datatrans.o \
@@ -18,3 +18,6 @@
 
 requests.o : requests.c Interface.h
 	$(CC) $(CFLAGS) -c $<
+
+clean:
+	rm -f core *.o motifd ; true
Index: src//tools/clmcom.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/clmcom.lisp,v
retrieving revision 1.19
diff -u -b -r1.19 clmcom.lisp
--- src//tools/clmcom.lisp	1997/11/04 16:29:36	1.19
+++ src//tools/clmcom.lisp	1999/09/06 01:27:30
@@ -74,23 +74,43 @@
     ("target:compile-motif.log")
 
   (with-compilation-unit
-      (:optimize '(optimize (speed 3) (ext:inhibit-warnings 3)
+      (:optimize  #-high-security
+                  '(optimize (speed 3)
+		             (ext:inhibit-warnings 3)
 			    #+small (safety 0)
-			    #+small (debug .5)))
+			    #+small (debug .5))
+		  #+high-security
+		  '(optimize (speed 2)
+		             (ext:inhibit-warnings 0)
+		             (safety 3)
+			     (debug 3)))
     
     (dolist (f tk-internals-files)
       (comf f :load t)))
   
   (with-compilation-unit
       (:optimize
-       '(optimize (debug #-small 2 #+small .5) 
+       #-(or small high-security)
+       '(optimize (debug 2) 
 		  (speed 2) (inhibit-warnings 2)
-		  (safety #-small 1 #+small 0))
+		  (safety 1))
+       #+small
+       '(optimize (debug .5) 
+		  (speed 2) (inhibit-warnings 2)
+		  (safety 0))
+       #+high-security
+       '(optimize (debug 3) 
+		  (speed 2) (inhibit-warnings 0)
+		  (safety 3))
        :optimize-interface
-       '(optimize-interface (debug .5))
+       '(optimize-interface (debug #-high-security .5
+			           #+high-security 3))
        :context-declarations
        '(((:and :external :global)
-	  (declare (optimize-interface (safety 2) (debug 1))))
+	  #-high-security
+	  (declare (optimize-interface (safety 2) (debug 1)))
+	  #+high-security
+	  (declare (optimize-interface (safety 3) (debug 3))))
 	 ((:and :external :macro)
 	  (declare (optimize (safety 2))))
 	 (:macro (declare (optimize (speed 0))))))
Index: src//tools/clxcom.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/clxcom.lisp,v
retrieving revision 1.26
diff -u -b -r1.26 clxcom.lisp
--- src//tools/clxcom.lisp	1999/01/09 11:05:20	1.26
+++ src//tools/clxcom.lisp	1999/09/06 01:27:30
@@ -27,11 +27,21 @@
 (with-compiler-log-file
     ("target:compile-clx.log"
      :optimize
-     '(optimize (debug #-small 2 #+small .5) 
+     #-(or small high-security)
+     '(optimize (debug 2) 
 		(speed 2) (inhibit-warnings 2)
-		(safety #-small 1 #+small 0))
+		(safety 1))
+     #+small
+     '(optimize (debug .5) 
+		(speed 2) (inhibit-warnings 2)
+		(safety 0))
+     #+high-security
+     '(optimize (debug 3) 
+		(speed 2) (inhibit-warnings 0)
+		(safety 3))
      :optimize-interface
-     '(optimize-interface (debug .5))
+     '(optimize-interface #-high-security (debug .5)
+                          #+high-security (debug 3))
      :context-declarations
      '(((:and :external :global)
 	(declare (optimize-interface (safety 2) (debug 1))))
Index: src//tools/comcom.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/comcom.lisp,v
retrieving revision 1.51
diff -u -b -r1.51 comcom.lisp
--- src//tools/comcom.lisp	1999/01/09 11:05:20	1.51
+++ src//tools/comcom.lisp	1999/09/06 01:27:30
@@ -29,21 +29,41 @@
 (with-compiler-log-file
     ("target:compile-compiler.log"
      :optimize
+     #-(or small high-security)
      '(optimize (speed 2) (space 2) (inhibit-warnings 2)
-		(safety #+small 0 #-small 1)
-		(debug #+small .5 #-small 2))
+		(safety 1)
+		(debug 2))
+     #+small
+     '(optimize (speed 2) (space 2) (inhibit-warnings 2)
+		(safety 0)
+		(debug .5))
+     #+high-security
+     '(optimize (speed 2) (space 2) (inhibit-warnings 0)
+		(safety 3)
+		(debug 3))
      :optimize-interface
-     '(optimize-interface (safety #+small 1 #-small 2)
-			  (debug #+small .5 #-small 2))
+     #-(or small high-security)
+     '(optimize-interface (safety 2)
+			  (debug 2))
+     #+small
+     '(optimize-interface (safety 1)
+       (debug .5))
+     #+high-security
+     '(optimize-interface (safety 3)
+                          (debug 3))
      :context-declarations
-     '(#+small
+     '(#+(or high-security small)
        ((:or :macro
 	     (:match "$SOURCE-TRANSFORM-" "$IR1-CONVERT-"
 		     "$PRIMITIVE-TRANSLATE-" "$PARSE-"))
-	(declare (optimize (safety 1))))
+	(declare (optimize (safety #+small 1
+				   #+high-security 3))))
        ((:or :macro (:match "$%PRINT-"))
 	(declare (optimize (speed 0))))
-       (:external (declare (optimize-interface (safety 2) (debug 1))))))
+       (:external #-high-security
+             	  (declare (optimize-interface (safety 2) (debug 1)))
+	          #+high-security
+	          (declare (optimize-interface (safety 3) (debug 3))))))
 
 
 (comf "target:compiler/macros"
@@ -181,6 +201,14 @@
 (comf (vmdir "target:compiler/array") :byte-compile *byte-compile*)
 (comf (vmdir "target:compiler/pred"))
 (comf (vmdir "target:compiler/type-vops") :byte-compile *byte-compile*)
+
+(when t ; PVE (c:target-featurep :direct-syscall)
+  (cond ((c:target-featurep :freebsd)
+         (comf (vmdir "target:compiler/syscall-freebsd")
+               :byte-compile *byte-compile*))
+        ((c:target-featurep :linux)
+         (comf (vmdir "target:compiler/syscall-linux")
+               :byte-compile *byte-compile*))))
 
 (comf (vmdir "target:assembly/assem-rtns") :byte-compile *byte-compile*)
 (comf (vmdir "target:assembly/array") :byte-compile *byte-compile*)
Index: src//tools/hemcom.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/hemcom.lisp,v
retrieving revision 1.9
diff -u -b -r1.9 hemcom.lisp
--- src//tools/hemcom.lisp	1999/01/09 11:05:20	1.9
+++ src//tools/hemcom.lisp	1999/09/06 01:27:30
@@ -134,7 +134,12 @@
      '(optimize (safety 2) (speed 0))
      :context-declarations
      '(((:match "-COMMAND$")
-	(declare (optimize (safety #+small 0 #-small 1))
+	(declare (optimize #-(or high-security small)
+		           (safety 1)
+			   #+small
+		           (safety 0)
+			   #+high-security
+		           (safety 3))
 		 (optimize-interface (safety 2))))))
 
 (comf "target:hemlock/command" :byte-compile t)
Index: src//tools/pclcom.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/pclcom.lisp,v
retrieving revision 1.19
diff -u -b -r1.19 pclcom.lisp
--- src//tools/pclcom.lisp	1999/01/09 11:05:20	1.19
+++ src//tools/pclcom.lisp	1999/09/06 01:27:30
@@ -80,10 +80,20 @@
 (import 'kernel:funcallable-instance-p (find-package "PCL"))
 
 (with-compilation-unit
-    (:optimize '(optimize (debug #+small .5 #-small 2)
-			  (speed 2) (safety #+small 0 #-small 2)
+    (:optimize #-(or high-security small)
+               '(optimize (debug 2)
+			  (speed 2) (safety 2)
 			  (inhibit-warnings 2))
-     :optimize-interface '(optimize-interface #+small (safety 1))
+	       #+small
+               '(optimize (debug .5)
+			  (speed 2) (safety 0)
+			  (inhibit-warnings 2))
+	       #+high-security
+               '(optimize (debug 3)
+			  (speed 2) (safety 3)
+			  (inhibit-warnings 0))
+     :optimize-interface '(optimize-interface #+small (safety 1)
+			                      #+high-security (safety 3))
      :context-declarations
      '((:external (declare (optimize-interface (safety 2) (debug 1))))
        ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
Index: src//tools/setup.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/setup.lisp,v
retrieving revision 1.29
diff -u -b -r1.29 setup.lisp
--- src//tools/setup.lisp	1999/01/09 11:05:20	1.29
+++ src//tools/setup.lisp	2000/02/03 19:22:56
@@ -201,7 +201,8 @@
 				       (declare (ignore condition))
 				       (format t "Error in backtrace!~%")))
 			      (format t "Error abort.~%")
-			      (return-from comf)))))
+			      (debug:backtrace)
+			      (quit t)))))
 	      (if assem
 		  (c::assemble-file src :output-file obj)
 		  (apply #'compile-file src :allow-other-keys t keys))))))))))
Index: src//tools/worldbuild.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/worldbuild.lisp,v
retrieving revision 1.41
diff -u -b -r1.41 worldbuild.lisp
--- src//tools/worldbuild.lisp	1998/05/01 01:21:42	1.41
+++ src//tools/worldbuild.lisp	1999/09/06 01:27:30
@@ -115,6 +115,8 @@
     ,@(if (c:backend-featurep :glibc2)
 	  '("target:code/unix-glibc2")
 	  '("target:code/unix"))
+    ,@(when (c:backend-featurep :direct-syscall)
+        '("target:code/unix-syscall"))
     ,@(when (c:backend-featurep :mach)
 	'("target:code/mach"
 	  "target:code/mach-os"))
Index: src//tools/worldcom.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/worldcom.lisp,v
retrieving revision 1.78
diff -u -b -r1.78 worldcom.lisp
--- src//tools/worldcom.lisp	1998/08/30 04:55:03	1.78
+++ src//tools/worldcom.lisp	1999/09/06 01:27:30
@@ -20,22 +20,39 @@
 
 (with-compiler-log-file
     ("target:compile-lisp.log"
-     :optimize '(optimize (speed 2) (space 2) (inhibit-warnings 2)
-			  (debug #-small 2 #+small .5)
-			  (safety #-small 1 #+small 0))
-     :optimize-interface '(optimize-interface (safety #-small 2 #+small 1)
-					      #+small (debug .5))
+ 	:optimize			
+ 	#-(or high-security small)
+ 	'(optimize (speed 2) (space 2) (inhibit-warnings 2)
+ 	  (debug 2)
+ 	  (safety 1))
+ 	#+small
+ 	'(optimize (speed 2) (space 2) (inhibit-warnings 2)
+ 	  (debug .5)
+ 	  (safety 0))
+ 	#+high-security
+ 	'(optimize (speed 2) (space 2) (inhibit-warnings 2)
+ 	  (debug 3)
+ 	  (safety 3))
+ 	:optimize-interface '(optimize-interface 
+ 			      #-(or hish-security small) (safety 2)
+ 			      #+small (safety 1)
+ 			      #+high-security (safety 3)
+ 			      #+small (debug .5)
+ 			      #+high-security (debug 3))
      :context-declarations
      '(((:or :external (:and (:match "%") (:match "SET"))
-	     (:member lisp::%put lisp::%rplaca lisp::%rplacd lisp::%puthash))
-	(declare (optimize-interface (safety 2) #+small (debug 1))
-		 #+small (optimize (debug 1))))
+ 		(:member lisp::%put lisp::%rplaca 
+ 			 lisp::%rplacd lisp::%puthash))
+ 	   (declare (optimize-interface (safety 2) #+small (debug 1)
+ 					#+high-security (debug 3))
+ 		    #+small (optimize (debug 1))
+ 		    #+high-security (optimize (debug 3))))
        ((:or (:and :external :macro)
 	     (:match "$PARSE-"))
 	(declare (optimize (safety 2))))
        ((:and :external (:match "LIST"))
 	(declare (optimize (safety 1))))))
-(let ((*byte-compile-top-level* nil))
+      (let ((*byte-compile-top-level* nil))
 
 ;;; these guys need to be first.
 (comf "target:code/struct") ; For structures.
@@ -143,6 +160,8 @@
 (if (c:backend-featurep :glibc2)
     (comf "target:code/unix-glibc2" :proceed t)
     (comf "target:code/unix" :proceed t))
+(when (c:backend-featurep :direct-syscall)
+  (comf "target:code/unix-syscall"))
 
 (when (c:backend-featurep :mach)
   (comf "target:code/mach")
@@ -262,6 +281,9 @@
 
 (comf "target:code/foreign")
 (comf "target:code/internet")
+(when (c:backend-featurep :direct-syscall)
+  (comf "target:code/internet-syscall"))
+
 (comf "target:code/wire")
 (comf "target:code/remote")
 (comf "target:code/cmu-site")
Index: src//tools/worldload.lisp
===================================================================
RCS file: /home/CVS-cmucl/src/tools/worldload.lisp,v
retrieving revision 1.88
diff -u -b -r1.88 worldload.lisp
--- src//tools/worldload.lisp	1998/01/16 07:22:25	1.88
+++ src//tools/worldload.lisp	1999/09/06 01:27:30
@@ -101,6 +101,7 @@
 #-gengc (maybe-byte-load "code:run-program")
 (maybe-byte-load "code:query")
 #-runtime (maybe-byte-load "code:internet")
+#-(or runtime (not direct-syscall)) (maybe-byte-load "code:internet-syscall")
 #-runtime (maybe-byte-load "code:wire")
 #-runtime (maybe-byte-load "code:remote")
 (maybe-byte-load "code:foreign")
