From 66018803be2f3abe8dcd950ba43b4c4122769be5 Mon Sep 17 00:00:00 2001
From: duane <duane>
Date: Wed, 20 Nov 1996 01:03:50 +0000
Subject: [PATCH] see 4.3.2.pre-beta.6 changelog entry for Tue Nov 19 16:58:41
 1996

---
 ChangeLog.n               |  9 ++++++++
 sys/defsystem.lisp        | 48 +++++++++++++++++++--------------------
 utils/lisp-utilities.lisp | 46 ++++++++++++++++++-------------------
 3 files changed, 56 insertions(+), 47 deletions(-)

diff --git a/ChangeLog.n b/ChangeLog.n
index 66d753b2..f7304cba 100644
--- a/ChangeLog.n
+++ b/ChangeLog.n
@@ -1,3 +1,12 @@
+*******************************************************************************
+4.3.2.pre-beta.6
+
+Tue Nov 19 16:58:41 1996  Duane Rettig  <duane@beta>
+
+	* sys/defsystem.lisp: comp -> excl
+
+	* utils/lisp-utilities.lisp: pointer-to-fixnum -> pointer-to-address
+
 *******************************************************************************
 4.3.2.pre-alpha.114
 
diff --git a/sys/defsystem.lisp b/sys/defsystem.lisp
index 9704582f..b718b48a 100644
--- a/sys/defsystem.lisp
+++ b/sys/defsystem.lisp
@@ -4,7 +4,7 @@
 ;;; DEFSYSTEM Utility
 ;;;
 ;;; Copyright (c) 1986 Regents of the University of California
-;;; 
+;;;
 ;;; Permission to use, copy, modify, and distribute this software and its
 ;;; documentation for any purpose and without fee is hereby granted,
 ;;; provided that the above copyright notice appear in all copies and
@@ -15,7 +15,7 @@
 ;;; permission.  The University of California makes no representations
 ;;; about the suitability of this software for any purpose.  It is
 ;;; provided "as is" without express or implied warranty.
-;;; 
+;;;
 
 ;;;-----------------------------------------------------------
 ;;; NOTE
@@ -59,14 +59,14 @@ Something is wrong if this warning appears!"))
     *language-descriptions*
     *load-all-before-compile*
     *sysdcl-pathname-defaults*
-    compile-system 
+    compile-system
     defsystem
     #+(or Genera Minima-Developer) import-into-sct
     load-system
     load-system-def
     set-system-source-file
     show-system
-    system-source-file 
+    system-source-file
     undefsystem
     with-compiler-options
     with-delayed-compiler-warnings
@@ -81,7 +81,7 @@ Something is wrong if this warning appears!"))
 		 :nicknames '("CLIM-DEFSYS"))
 
 #-(or ANSI-90 Genera-Release-8-0 Genera-Release-8-1)
-(lisp:in-package #-(or lispworks ANSI-90) :clim-defsystem 
+(lisp:in-package #-(or lispworks ANSI-90) :clim-defsystem
 		 #+lispworks :pdefsys
 		 #+ANSI-90 :clim-defsystem
 		 #-ANSI-90 :use #-ANSI-90 '(:lisp)
@@ -93,14 +93,14 @@ Something is wrong if this warning appears!"))
 	  *language-descriptions*
 	  *load-all-before-compile*
 	  *sysdcl-pathname-defaults*
-	  compile-system 
+	  compile-system
 	  defsystem
 	  #+(or Genera Minima-Developer) import-into-sct
 	  load-system
 	  load-system-def
 	  set-system-source-file
 	  show-system
-	  system-source-file 
+	  system-source-file
 	  undefsystem
 	  with-compiler-options
 	  with-delayed-compiler-warnings)
@@ -117,7 +117,7 @@ Something is wrong if this warning appears!"))
 		     "Attempting to add the name ~S to package ~S, which doesn't exist")
 	     (when (null (find-package add-name))
 	       (let (#+Allegro (excl::*enable-package-locked-errors* nil))
-		 (rename-package 
+		 (rename-package
 		   pack (package-name pack)
 		   (list* add-name (package-nicknames pack))))))))
     (fix-package :common-lisp :lisp)
@@ -187,7 +187,7 @@ Something is wrong if this warning appears!"))
 ;; Uses :RELATIVE instead of :UP
 ;; Uses "*" instead of :WILD
 ;; Merge-pathnames still loses, since it doesn't do the right thing wrt relative
-;;  pathnames. 
+;;  pathnames.
 ;;
 #+ibcl
 (progn
@@ -321,7 +321,7 @@ Something is wrong if this warning appears!"))
 				       "/")))
 	dirstring)
       directory))
-  
+
 )
 
 
@@ -376,17 +376,17 @@ Something is wrong if this warning appears!"))
 				       "/")))
 	dirstring)
       directory))
-  
+
 )
 
 ;; Macintosh Allegro CL
 ;;
 #+(and ccl (not ANSI-90))
 (progn ; slh
-  
+
   (defun externalize-directory (directory)
     `(:absolute ,directory))
-  
+
   (defun internalize-directory (directory)
     (flet ((string-append (str1 str2)
              (concatenate 'string str1 str2 ":")))
@@ -395,10 +395,10 @@ Something is wrong if this warning appears!"))
 
 #+(and cmu (not ANSI-90))
 (progn
-  
+
   (defun externalize-directory (directory)
     (cons :absolute (coerce directory 'list)))
-  
+
   (defun internalize-directory (directory)
     (assert (eq (car directory) :absolute))
     (coerce (cdr directory) 'vector))
@@ -406,10 +406,10 @@ Something is wrong if this warning appears!"))
 
 #+(and ANSI-90 (not Genera) (not Cloe) (not Minima) (not Allegro))
 (progn ; rwk
-  
+
   (defun externalize-directory (directory)
     directory)
-  
+
   (defun internalize-directory (directory)
     directory)
 )
@@ -526,7 +526,7 @@ Something is wrong if this warning appears!"))
   #+(or Genera Cloe-Runtime lispworks CCL-2)
   (format t "~&; Compiling ~A~%" pathname)
   #+CCL-2
-  (ccl:set-mini-buffer ccl:*top-listener* "~A: Compiling ~A." 
+  (ccl:set-mini-buffer ccl:*top-listener* "~A: Compiling ~A."
                        *current-system*
                        (namestring pathname))
   (let (#+Minima (*compile-verbose* t))
@@ -534,7 +534,7 @@ Something is wrong if this warning appears!"))
 	(eval `(locally (declare (optimize ,@optimizations))
 			(compile-file ',pathname :output-file binary-pathname)))
 	(compile-file pathname :output-file binary-pathname))))
-     
+
 
 (defun load-lisp-file (pathname &optional libraries)
   (declare (ignore libraries))
@@ -751,7 +751,7 @@ Something is wrong if this warning appears!"))
 			   for remove-n = (max (- (length p) length-this-try) 0)
 			   for next-char = nil
 			     then (and (> (length shortened-string) 0)
-				       (char shortened-string 
+				       (char shortened-string
 					     (1- (length shortened-string))))
 			   for shortened-string = (shorten-string p remove-n next-char)
 			   do (setf (car l) shortened-string)
@@ -1176,7 +1176,7 @@ pathname fields are evaluated."
 ;; The following are used to prevent multiple compilations/loads from occuring
 ;; during a single call to LOAD-SYSTEM or COMPILE-SYSTEM.
 (eval-when (eval compile)
-  (proclaim '(special *loaded-systems* *loaded-modules* 
+  (proclaim '(special *loaded-systems* *loaded-modules*
 		      *compiled-systems* *compiled-modules*
 		      *tracep*)))
 
@@ -1184,7 +1184,7 @@ pathname fields are evaluated."
 (#+Allegro excl::without-package-locks #-Allegro progn
 
 (defun translate-logical-pathname (path) path)
-	   
+
 )
 
 ;; Compute the package to use in a module environment
@@ -1525,7 +1525,7 @@ verify that each already loaded subsystem is up-to-date, reloading it if need be
 (defun import-into-sct (system &key (subsystem nil)
 				    (sct-name system) pretty-name
 				    default-pathname default-destination-pathname
-				    journal-directory 
+				    journal-directory
 				    (maintain-journals (not subsystem))
 				    (patchable maintain-journals)
 				    bug-reports patches-reviewed
@@ -1581,7 +1581,7 @@ verify that each already loaded subsystem is up-to-date, reloading it if need be
 	      (system-module-list system)))))
 
 (defun get-compiler-speed-and-safety ()
-  #+Allegro (values comp::.speed. comp::.safety.)
+  #+Allegro (values excl::.speed. excl::.safety.)
   #+Genera (values (lt:optimize-state 'speed) (lt:optimize-state 'safety))
   #+Lucid (values (cdr (assoc 'speed lucid::*compiler-optimizations*))
 		  (cdr (assoc 'safety lucid::*compiler-optimizations*)))
diff --git a/utils/lisp-utilities.lisp b/utils/lisp-utilities.lisp
index faaa5faf..a175cfe9 100644
--- a/utils/lisp-utilities.lisp
+++ b/utils/lisp-utilities.lisp
@@ -12,7 +12,7 @@
 (defvar *keyword-package* (find-package :keyword))
 
 ;;; FUNCTIONP doesn't do what we want and there isn't any other CL function
-;;; that does. 
+;;; that does.
 (defun funcallable-p (thing)
   (etypecase thing
     (symbol (fboundp thing))
@@ -54,7 +54,7 @@
 	(env nil)
 	(vl variables))
     (loop
-      (when (null vl) 
+      (when (null vl)
 	(return-from decode-once-only-arguments
 	  (values (nreverse vars) env)))
       (let ((var (pop vl)))
@@ -111,7 +111,7 @@
 
 ;;; Stuff for dealing with CLIM coordinates
 
-(deftype coordinate () 
+(deftype coordinate ()
   #+use-float-coordinates  'single-float
   #+use-fixnum-coordinates 'fixnum
   #-(or use-float-coordinates use-fixnum-coordinates) 't)
@@ -161,7 +161,7 @@
     (fixnum
      coord)
     (single-float
-     ;; note we use [x+0.5] rather than ROUND because 
+     ;; note we use [x+0.5] rather than ROUND because
      ;; (1+ (round 1.5)) != (round 2.5) (cim 8/6/94)
      (values (the fixnum (floor (+ (the single-float coord) .5f0)))))
     (double-float
@@ -204,7 +204,7 @@
     `(progn
        ,@(let ((forms nil))
 	   (dorest (pts coordinate-pairs cddr)
-	     (push `(setf ,(first pts)  
+	     (push `(setf ,(first pts)
 			  (the coordinate (+ ,(first pts)  ,x-delta))) forms)
 	     (push `(setf ,(second pts)
 			  (the coordinate (+ ,(second pts) ,y-delta))) forms))
@@ -223,7 +223,7 @@
       (let* ((x (pop positions))
 	     (y (pop positions)))
 	(push `(progn
-		 (multiple-value-setq (,x ,y) 
+		 (multiple-value-setq (,x ,y)
 		   (transform-position ,transform ,x ,y))
 		 (fix-coordinates ,x ,y))
 	      forms)))))
@@ -241,7 +241,7 @@
       (let* ((x (pop distances))
 	     (y (pop distances)))
 	(push `(progn
-		 (multiple-value-setq (,x ,y) 
+		 (multiple-value-setq (,x ,y)
 		   (transform-distance ,transform ,x ,y))
 		 (fix-coordinates ,x ,y))
 	      forms)))))
@@ -324,7 +324,7 @@
 ;;; because the user might declare the stream variable to be of type STREAM, which
 ;;; would not be true during the brief interval after the binding and before the
 ;;; setting of that variable.  I believe this implementation of WITH-OPEN-STREAM to
-;;; have as small a timing window, and to be as semantically correct as possible. 
+;;; have as small a timing window, and to be as semantically correct as possible.
 
 #+(or (not CLIM-uses-Lisp-stream-functions)	;Do this if we provide CLOSE function
       Genera					; Sigh.  CLOSE also shadowed for Genera.
@@ -355,7 +355,7 @@
 				 (t stream))
   #-(or Genera ANSI-90) stream)
 
-#-(or Genera ANSI-90) 
+#-(or Genera ANSI-90)
 (eval-when (compile)
   (warn "You haven't defined ~S for this implementation.  A stub has been provided."
 	'follow-synonym-stream))
@@ -651,7 +651,7 @@
   (si::rem-keywords list keywords-to-remove))
 
 #-(or Genera Cloe-Runtime)
-(progn 
+(progn
 (defmacro with-keywords-removed ((new-list list keywords-to-remove) &body body)
   `(let ((,new-list (remove-keywords ,list ,keywords-to-remove)))
      ,@body))
@@ -764,7 +764,7 @@
 ;; 		          &key frotz (trouble) ((:izzy the-cat))))
 ;; (FOO BAR BAZ QUUX MUMBLE :FROTZ FROTZ :TROUBLE TROUBLE ':IZZY THE-CAT)
 ;; --- It looks like &REST and &KEY don't get along well here.  A big
-;; question in such a circumstane is who should be doing the defaulting?  
+;; question in such a circumstane is who should be doing the defaulting?
 ;; I.e., should this do the defaulting, by making the above arglist be
 ;; 	:FROTZ FROTZ :TROUBLE TROUBLE ':IZZY THE-CAT MUMBLE
 ;; for apply, or should it let the eventual caller do the defaulting by
@@ -827,7 +827,7 @@
 		(nreverse args))
 	    nil)))
 
-(defun canonicalize-and-match-lambda-lists (canonical-order user-specified 
+(defun canonicalize-and-match-lambda-lists (canonical-order user-specified
 					    &optional allow-user-keys)
   (declare (values lambda-list ignores))
   (check-type canonical-order list)
@@ -840,7 +840,7 @@
     (when allow-user-keys
       (setq user-specified (subseq user-specified 0 (min rest-pos key-pos))))
     (flet ((user-var-symbol (entry)
-	     ;; FOO | (FOO NIL) | ((:FOO BAR) NIL) | (FOO NIL FOO-P) | ((:FOO BAR) FOO-P) 
+	     ;; FOO | (FOO NIL) | ((:FOO BAR) NIL) | (FOO NIL FOO-P) | ((:FOO BAR) FOO-P)
 	     ;;--- We don't support the FOO-P syntax yet.
 	     (cond ((atom entry)
 		    entry)
@@ -848,7 +848,7 @@
 		    entry)
 		   (t (second entry))))
 	   (user-var-name (entry)
-	     ;; FOO | (FOO NIL) | ((:FOO BAR) NIL) | (FOO NIL FOO-P) | ((:FOO BAR) FOO-P) 
+	     ;; FOO | (FOO NIL) | ((:FOO BAR) NIL) | (FOO NIL FOO-P) | ((:FOO BAR) FOO-P)
 	     ;;--- We don't support the FOO-P syntax yet.
 	     (cond ((atom entry)
 		    entry)
@@ -872,7 +872,7 @@
       (when (set-difference user-specified '(&key &allow-other-keys))
 	(error "The arguments ~S aren't valid for this lambda list."
 	       user-specified))
-      (values (if allow-user-keys 
+      (values (if allow-user-keys
 		  (append (nreverse new-lambda-list) rest-and-key)
 		  (nreverse new-lambda-list))
 	      (nreverse ignores)))))
@@ -884,7 +884,7 @@
 
 #-Genera
 (defmacro defun-property ((symbol indicator) lambda-list &body body)
-  (let ((function-name 
+  (let ((function-name
 	  (make-symbol (lisp:format nil "~A-~A-~A" symbol indicator 'property))))
     `(progn (defun ,function-name ,lambda-list ,@body)
 	    (eval-when (load eval) (setf (get ',symbol ',indicator) #',function-name)))))
@@ -1081,7 +1081,7 @@
 #-(or PCL Genera ANSI-90)
 (defun print-unreadable-object-identity (object stream)
   #+Genera (format stream "~O" (sys:%pointer object))
-  #+Allegro (format stream "@~X" (excl::pointer-to-fixnum object))
+  #+Allegro (format stream "@~X" (excl::pointer-to-address object))
   ;; Lucid prints its addresses out in Hex.
   #+Lucid (format stream "~X" (sys:%pointer object))
   ;; Probably aren't any #+(and (not Genera) (not Allegro) (not PCL) (not ANSI-90))
@@ -1107,7 +1107,7 @@
   (typep x 'real))
 
 (defconstant *end-of-file-marker* :eof)
-(deftype end-of-file-marker () 
+(deftype end-of-file-marker ()
   '(member :eof))
 
 #+Cloe-Runtime
@@ -1340,7 +1340,7 @@
 	   ;; Grow the vector, leaving a hole for the new element
 	   (let ((new-vector (make-array (+ length (max (ash length -1) (or extension 20)))
 					 :element-type (array-element-type vector))))
-	     (copy-vector-portion vector 0 new-vector 0 index) 
+	     (copy-vector-portion vector 0 new-vector 0 index)
 	     (copy-vector-portion vector index new-vector (1+ index) (- length index))
 	     (setq vector new-vector)))
 	  (t
@@ -1369,7 +1369,7 @@
 ;;; The idea here is to provide a macro that will arrange for the abort choice
 ;;; to be on the "Abort" debugger choice, if possible.
 ;;; I would just use WITH-SIMPLE-RESTART but in Genera that doesn't end up
-;;; on the <Abort> key.  Note that in Allegro, this choice ends up as an ordinary 
+;;; on the <Abort> key.  Note that in Allegro, this choice ends up as an ordinary
 ;;; proceed option, but in Lucid it ends up on ":A".
 (defmacro with-simple-abort-restart ((format-string &rest format-args) &body body)
   #{
@@ -1418,7 +1418,7 @@
 ;;; objects which have the right properties flavors mixed in.
 (defmacro define-class-mixture-and-resource (name (&key initializer initial-copies)
 					     &body specs)
-  (let ((matcher-function-name 
+  (let ((matcher-function-name
 	  (make-symbol (lisp:format nil "~A-~A" name 'matcher)))
 	(constructor-function-name
 	  (make-symbol (lisp:format nil "~A-~A" name 'constructor))))
@@ -1478,7 +1478,7 @@
 		 (when (and (> (length class-name) 6)
 			    (string-equal class-name "BASIC-" :end1 6))
 		   (setf class-name (substring class-name 6)))
-		 (when (and (> (length class-name) 6) 
+		 (when (and (> (length class-name) 6)
 			    (string-equal class-name "-MIXIN"
 					  :start1 (- (length class-name) 6)))
 		   (setf class-name (substring class-name 0 (- (length class-name) 6))))
@@ -1516,7 +1516,7 @@
 		   (assert (null (cdr rest)) ()
 			   "A component-class mixture spec must stand alone. ~S is incorrect."
 			   first-spec)
-		   (return-from process-specs 
+		   (return-from process-specs
 		     `(if ,variable-name
 			  ,(process-specs (cdr specs) (cons (first rest) classes-so-far))
 			  ,(process-specs (cdr specs) classes-so-far))))
-- 
GitLab