(FILECREATED "15-Jan-86 17:44:30" {ERIS}<LISPCORE>CML>LAB>CMLPACKAGE.;5
 13441  

      changes to:  (MACROS SYMBOL-PACKAGE SETF-SYMBOL-PACKAGE DO-ALL-SYMBOLS DO-EXTERNAL-SYMBOLS 
			   DO-SYMBOLS PKG::LISTIFY PKG::PACKAGIFY)
		   (VARS CMLPACKAGECOMS)
		   (FNS SYMBOL-PACKAGE SETF-SYMBOL-PACKAGE MAKE-PACKAGE PKG::INITIALIZE 
			PKG::FIND-FREE-PACKAGE-INDEX EXPORT FIND-ALL-SYMBOLS FIND-PACKAGE FIND-SYMBOL 
			IMPORT IN-PACKAGE INTERN LIST-ALL-PACKAGES RENAME-PACKAGE SHADOW 
			SHADOWING-IMPORT UNEXPORT UNINTERN UNUSE-PACKAGE USE-PACKAGE)
		   (RECORDS SYMBOL)

      previous date: " 2-Dec-85 16:07:11" {ERIS}<LISPCORE>CML>LAB>CMLPACKAGE.;2)


(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT CMLPACKAGECOMS)

(RPAQQ CMLPACKAGECOMS
 [(FILES CMLHASH CMLSYMBOL CMLMVS)
	(* * Should be in CMLSYMBOL but needs internal rep)
	(MACROS SYMBOL-PACKAGE SETF-SYMBOL-PACKAGE)
	(FNS SYMBOL-PACKAGE SETF-SYMBOL-PACKAGE)
	(* * External interface)
	(MACROS DO-ALL-SYMBOLS DO-EXTERNAL-SYMBOLS DO-SYMBOLS)
	(FNS EXPORT FIND-ALL-SYMBOLS FIND-PACKAGE FIND-SYMBOL IMPORT IN-PACKAGE INTERN 
	     LIST-ALL-PACKAGES MAKE-PACKAGE RENAME-PACKAGE SHADOW SHADOWING-IMPORT UNEXPORT UNINTERN 
	     UNUSE-PACKAGE USE-PACKAGE)
	(* * And the FNS: PACKAGE-NAME PACKAGE-NICKNAMES PACKAGE-SHADOWING-SYMBOLS PACKAGE-USE-LIST 
	   PACKAGE-USED-BY-LIST)
	(* * Internal interface)
	(RECORDS PACKAGE SYMBOL)
	(INITVARS (PKG::ALL-PACKAGES NIL)
		  (PKG::KEYWORD-PACKAGE NIL)
		  (PKG::INDEX-TO-PACKAGE-VECTOR NIL)
		  (PKG::PACKAGE-TO-INDEX-HASHTABLE NIL))
	(MACROS PKG::LISTIFY PKG::PACKAGIFY)
	(FNS PKG::INITIALIZE PKG::FIND-INHERITED-SYMBOL PKG::STRINGIFY PKG::FIND-FREE-PACKAGE-INDEX 
	     ADD-NICKNAMES)
	(P (PKG::INITIALIZE))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
		  (ADDVARS (NLAMA)
			   (NLAML)
			   (LAMA USE-PACKAGE UNUSE-PACKAGE UNINTERN UNEXPORT SHADOWING-IMPORT SHADOW 
				 RENAME-PACKAGE MAKE-PACKAGE INTERN IN-PACKAGE IMPORT FIND-SYMBOL 
				 EXPORT])
(FILESLOAD CMLHASH CMLSYMBOL CMLMVS)
(* * Should be in CMLSYMBOL but needs internal rep)


(DECLARE: EVAL@COMPILE 
[PUTPROPS SYMBOL-PACKAGE DMACRO ((obj)
	   (AREF PKG::INDEX-TO-PACKAGE-VECTOR (ffetch (SYMBOL PACKAGE)
						      of obj]
[PUTPROPS SETF-SYMBOL-PACKAGE DMACRO ((obj value)
	   (freplace (SYMBOL PACKAGE)
		     of obj with (CL:GETHASH PKG::PACKAGE-TO-INDEX-HASHTABLE value]
)
(DEFINEQ

(SYMBOL-PACKAGE

  (CL:LAMBDA (SYMBOL)                                        (* raf "14-Jan-86 13:27")

    (
AREF
 PKG::INDEX-TO-PACKAGE-VECTOR (ffetch
 (SYMBOL PACKAGE) of
 SYMBOL))))

(SETF-SYMBOL-PACKAGE

  (CL:LAMBDA (SYMBOL PACKAGE)                                (* raf "14-Jan-86 13:23")

    (freplace
 (SYMBOL PACKAGE) of
 SYMBOL with
 (
CL:GETHASH
 PKG::PACKAGE-TO-INDEX-HASHTABLE 
								  PACKAGE))))
)
(* * External interface)


(DECLARE: EVAL@COMPILE 
(DEFMACRO DO-ALL-SYMBOLS (&BODY FORM)
	  NIL)
(DEFMACRO DO-EXTERNAL-SYMBOLS (&BODY FORM)
	  NIL)
(DEFMACRO DO-SYMBOLS (&BODY FORM)
	  NIL)
)
(DEFINEQ

(EXPORT

  (CL:LAMBDA (SYMBOLS &OPTIONAL PACKAGE)
    NIL))

(FIND-ALL-SYMBOLS

  (CL:LAMBDA (STRING-OR-SYMBOL)
    NIL))

(FIND-PACKAGE

  (CL:LAMBDA (NAME)                                          (* raf "17-Nov-85 02:20")

    (
CL:GETHASH
 (PKG::STRINGIFY
 NAME)
		  PKG::ALL-PACKAGES NIL)))

(FIND-SYMBOL

  [CL:LAMBDA (
STRING
 &OPTIONAL (PACKAGE *PACKAGE*))        (* raf "19-Nov-85 17:00")

    (LET (SYMBOL)
         (
COND

	   ((
SETQ
 SYMBOL (
CL:GETHASH
 STRING (PACKAGE-INTERNALS-HASHTABLE PACKAGE)))
	     (
VALUES
 SYMBOL :INTERNAL))
	   ((
SETQ
 SYMBOL (
CL:GETHASH
 STRING (PACKAGE-EXTERNALS-HASHTABLE PACKAGE)))
	     (
VALUES
 SYMBOL :EXTERNAL))
	   (T (PKG::FIND-INHERITED-SYMBOL
 STRING (PACKAGE-USE-LIST PACKAGE])

(IMPORT

  (CL:LAMBDA (SYMBOLS &OPTIONAL PACKAGE)
    NIL))

(IN-PACKAGE

  (CL:LAMBDA (PACKAGE-NAME &KEY NICKNAMES USE)               (* raf "17-Nov-85 02:44")

    (SETF *PACKAGE* (
OR
 (FIND-PACKAGE
 PACKAGE-NAME)
			  (MAKE-PACKAGE
 PACKAGE-NAME)))
    (ADD-NICKNAMES
 NICKNAMES *PACKAGE*)
    (USE-PACKAGE
 USE *PACKAGE*)))

(INTERN

  [CL:LAMBDA (
STRING
 &OPTIONAL (PACKAGE *PACKAGE*))        (* raf "19-Nov-85 16:53")

    "Put symbol in package.  Special case for KEYWORD package (always :EXTERNAL, always self-eval)"
    (MULTIPLE-VALUE-BIND (SYMBOL TYPE)
			 (FIND-SYMBOL
 STRING PACKAGE)
			 (CL:IF SYMBOL (
VALUES
 SYMBOL TYPE)
				(CL:IF (
EQ
 PACKAGE PKG::KEYWORD-PACKAGE)
				       (
MULTIPLE-VALUE-PROG1
 (
VALUES
 (
SETQ
 SYMBOL
									   (
CL:PUTHASH

									     STRING
									     (
PACKAGE-EXTERNALS-HASHTABLE PACKAGE)
									     (
MAKE-SYMBOL
 :NAME 
											   STRING 
											 :PACKAGE 
											  PACKAGE)))
									 :EXTERNAL)
							       (
SET
 SYMBOL SYMBOL))
				       (
VALUES
 (
CL:PUTHASH
 STRING (PACKAGE-INTERNALS-HASHTABLE
								 PACKAGE)
							       (
MAKE-SYMBOL
 :NAME STRING :PACKAGE 
									      PACKAGE))
						 :INTERNAL])

(LIST-ALL-PACKAGES

  (CL:LAMBDA NIL                                             (* raf "17-Nov-85 02:35")

    (LET ((ALL NIL))
         (
CL:MAPHASH
 (
FUNCTION
 [LAMBDA (NAME PACKAGE)
			   (CL:PUSH PACKAGE ALL])
		       PKG::ALL-PACKAGES)
     ALL)))

(MAKE-PACKAGE

  (CL:LAMBDA (PACKAGE-NAME &KEY NICKNAMES (USE "LISP"))      (* raf "14-Jan-86 18:44")

    (LET ([NEW-PACKAGE (
INTERNAL-MAKE-PACKAGE
 :NAME PACKAGE-NAME :NICKNAMES NIL :USE-LIST NIL 
						:USED-BY-LIST NIL :SHADOWING-SYMBOLS NIL :HASHTABLE
						(
MAKE-HASH-TABLE
 :SIZE 20 :TEST (
QUOTE
 EQUAL
))
						:EXTERNALS
						(
MAKE-HASH-TABLE
 :SIZE 5 :TEST (
QUOTE
 EQUAL
]
	  (PACKAGE-INDEX (PKG::FIND-FREE-PACKAGE-INDEX
)))
         (SETF (
CL:GETHASH
 PACKAGE-NAME PKG::ALL-PACKAGES)
	       NEW-PACKAGE)
         (SETF (
CL:GETHASH
 PKG::PACKAGE-TO-INDEX-HASHTABLE NEW-PACKAGE)
	       PACKAGE-INDEX)
         (SETF (
AREF
 PKG::INDEX-TO-PACKAGE-VECTOR PACKAGE-INDEX)
	       NEW-PACKAGE)
         (ADD-NICKNAMES
 NICKNAMES NEW-PACKAGE)
         (USE-PACKAGE
 USE NEW-PACKAGE)
     NEW-PACKAGE)))

(RENAME-PACKAGE

  (CL:LAMBDA (PACKAGE NEW-NAME &OPTIONAL NEW-NICKNAMES)      (* raf "17-Nov-85 03:01")

    (
REMHASH
 (PACKAGE-NAME PACKAGE)
	       PKG::ALL-PACKAGES)
    (
CL:MAPCAR
 (
FUNCTION
 [LAMBDA (N)
		     (
REMHASH
 N PKG:ALL-PACKAGES])
		 (PACKAGE-NICKNAMES PACKAGE))
    (SETF (PACKAGE-NAME PACKAGE)
	  (PKG::STRINGIFY
 NEW-NAME))
    (ADD-NICKNAMES
 NEW-NICKNAMES PACKAGE)))

(SHADOW

  (CL:LAMBDA (SYMBOLS &OPTIONAL PACKAGE)
    NIL))

(SHADOWING-IMPORT

  (CL:LAMBDA (SYMBOLS &OPTIONAL PACKAGE)
    NIL))

(UNEXPORT

  (CL:LAMBDA (SYMBOLS &OPTIONAL PACKAGE)
    NIL))

(UNINTERN

  [CL:LAMBDA (SYMBOL &OPTIONAL (PACKAGE *PACKAGE*))          (* raf "19-Nov-85 17:08")

    (LET (SYMBOL HASHTABLE (
STRING
 (
SYMBOL-NAME
 SYMBOL)))
         (
COND

	   ([
OR
 [
SETQ
 SYMBOL (
CL:GETHASH
 STRING (
SETQ
 HASHTABLE (PACKAGE-INTERNALS-HASHTABLE
						   PACKAGE]
		  (
SETQ
 SYMBOL (
CL:GETHASH
 STRING (
SETQ
 HASHTABLE (PACKAGE-EXTERNALS-HASHTABLE
						   PACKAGE]
	     (
REMHASH
 STRING HASHTABLE)
	     (SETF (PACKAGE-SHADOWING-SYMBOLS PACKAGE)
		   (
REMOVE
 SYMBOL (PACKAGE-SHADOWING-SYMBOLS PACKAGE)))
	     (CL:IF (
EQ
 PACKAGE (
SYMBOL-PACKAGE
 SYMBOL))
		    (SETF (
SYMBOL-PACKAGE
 SYMBOL)
			  NIL))
	     T)
	   (T NIL])

(UNUSE-PACKAGE

  (CL:LAMBDA (PACKAGES-TO-UNUSE &OPTIONAL PACKAGE)
    NIL))

(USE-PACKAGE

  (CL:LAMBDA (PACKAGES-TO-USE &OPTIONAL (PACKAGE *PACKAGE*))
                                                             (* raf "13-Jan-86 22:03")

    (
CL:MAPCAR
 [
FUNCTION
 (LAMBDA (X)
		     (
SETQ
 X (PKG::PACKAGIFY X))
		     (CL:PUSH X (PACKAGE-USE-LIST PACKAGE))
		     (CL:PUSH PACKAGE (PACKAGE-USED-BY-LIST X]
		 (PKG::LISTIFY PACKAGES-TO-USE))))
)
(* * And the FNS: PACKAGE-NAME PACKAGE-NICKNAMES PACKAGE-SHADOWING-SYMBOLS PACKAGE-USE-LIST 
PACKAGE-USED-BY-LIST)


(* * Internal interface)


[DECLARE: EVAL@COMPILE 
(
DEFSTRUCT
 (PACKAGE (:CONSTRUCTOR INTERNAL-MAKE-PACKAGE)
		      (:PRINT-FUNCTION NIL))
	     NAME NICKNAMES INTERNALS-HASHTABLE USE-LIST USED-BY-LIST SHADOWING-SYMBOLS 
	     EXTERNALS-HASHTABLE)

(ACCESSFNS SYMBOL
 ((DEFINITIONCELL (\DEFCELL DATUM))
		     (PROPCELL (\PROPCELL DATUM))
		     (VCELL (\VALCELL DATUM))
		     (PNAMECELL (\PNAMECELL DATUM)))

          (* * VCELL can also be accessed directly from a value index via the record VALINDEX (as in \SETGLOBALVAL.UFN) -

	  Similarly, PNAMEINDEX accesses PNAMECELL for use by \MKATOM and UNCOPYATOM)



		    (TYPE?
 (
LITATOM
 DATUM))
		    (
BLOCKRECORD
 PROPCELL ((NIL BITS 1)
				    (GENSYMP FLAG)
				    (FATPNAMEP FLAG)
				    (NIL BITS 5)
				    (PROPLIST POINTER)))
		    (
BLOCKRECORD
 PNAMECELL ((PACKAGE BITS 8)
				    (PNAMESTR POINTER))))
]
(/DECLAREDATATYPE (QUOTE PACKAGE)
		  (QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER))
		  (QUOTE ((PACKAGE 0 POINTER)
			  (PACKAGE 2 POINTER)
			  (PACKAGE 4 POINTER)
			  (PACKAGE 6 POINTER)
			  (PACKAGE 8 POINTER)
			  (PACKAGE 10 POINTER)
			  (PACKAGE 12 POINTER)))
		  (QUOTE 14))

(RPAQ? PKG::ALL-PACKAGES
 NIL)

(RPAQ? PKG::KEYWORD-PACKAGE
 NIL)

(RPAQ? PKG::INDEX-TO-PACKAGE-VECTOR
 NIL)

(RPAQ? PKG::PACKAGE-TO-INDEX-HASHTABLE
 NIL)
(DECLARE: EVAL@COMPILE 
[DEFMACRO PKG::LISTIFY (X)
	  (BQUOTE (CL:IF (LISTP (\, X))
			 (\, X)
			 (LIST (\, X]
[DEFMACRO PKG::PACKAGIFY (X)
	  (BQUOTE (CL:IF (PACKAGE-P (\, X))
			 (\, X)
			 (FIND-PACKAGE (\, X]
)
(DEFINEQ

(PKG::INITIALIZE

  (CL:LAMBDA NIL                                             (* raf "14-Jan-86 18:44")

    (SETF PKG::ALL-PACKAGES (
MAKE-HASH-TABLE
 :SIZE 512 :TEST (
QUOTE
 EQUAL
)))
    (SETF PKG::INDEX-TO-PACKAGE-VECTOR (
MAKE-ARRAY
 256 :INITIAL-ELEMENT NIL))
    (SETF PKG::PACKAGE-TO-INDEX-HASHTABLE (
MAKE-HASH-TABLE
 :SIZE 512 :TEST (
QUOTE
 EQL)))
    (MAKE-PACKAGE
 "LISP")
    (SETF PKG::KEYWORD-PACKAGE (MAKE-PACKAGE
 "KEYWORD"))
    (MAKE-PACKAGE
 "SYSTEM")
    (SETF *PACKAGE* (MAKE-PACKAGE
 "USER" :USE "LISP"))))

(PKG::FIND-INHERITED-SYMBOL

  [CL:LAMBDA (STRING PACKAGES)                               (* raf "19-Nov-85 16:12")

    (CL:DO* ((PACKAGE PACKAGES (
CDR
 PACKAGES))
	     (SYMBOL (
CL:GETHASH
 STRING (PACKAGE-EXTERNALS-HASHTABLE PACKAGE)
				   NIL)
		     (
CL:GETHASH
 STRING (PACKAGE-EXTERNALS-HASHTABLE PACKAGE)
				   NIL)))
	    ((
OR
 SYMBOL (
NULL
 PACKAGE))
	     (CL:IF SYMBOL (
VALUES
 SYMBOL :EXTERNAL)
		    NIL])

(PKG::STRINGIFY

  (CL:LAMBDA (OBJECT)                                        (* raf "10-Oct-85 18:24")

    (CL:IF (
STRINGP
 OBJECT)
	   OBJECT
	   (
SYMBOL-NAME
 OBJECT))))

(PKG::FIND-FREE-PACKAGE-INDEX

  [CL:LAMBDA NIL
    (CL:DO ((I 1 (INCR I)))
	   ((
=
 I MAX-NUMBER-PACKAGES)
	    (
ERROR
 "Package space full" NIL))
	   (CL:IF (
NULL
 (
AREF
 PKG::INDEX-TO-PACKAGE-VECTOR I))
		  (
RETURN
 I])

(ADD-NICKNAMES

  (CL:LAMBDA (NICKNAMES PACKAGE)                             (* raf "17-Nov-85 02:56")

    (
CL:MAPCAR
 [
FUNCTION
 (LAMBDA (X)
		     (SETF X (PKG::STRINGIFY
 X))
		     (SETF (
CL:GETHASH
 X PKG::ALL-PACKAGES)
			   PACKAGE)
		     (CL:PUSH X (
PACKAGE-NICKNAMES
 PACKAGE]
		 NICKNAMES)))
)
(PKG::INITIALIZE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 USE-PACKAGE UNUSE-PACKAGE UNINTERN UNEXPORT SHADOWING-IMPORT SHADOW RENAME-PACKAGE 
			     MAKE-PACKAGE INTERN IN-PACKAGE IMPORT FIND-SYMBOL EXPORT)
)
(PRETTYCOMPRINT CMLPACKAGECOMS)

(RPAQQ CMLPACKAGECOMS
 [(FILES CMLHASH CMLSYMBOL CMLMVS)
	(* * Should be in CMLSYMBOL but needs internal rep)
	(MACROS SYMBOL-PACKAGE SETF-SYMBOL-PACKAGE)
	(FNS SYMBOL-PACKAGE SETF-SYMBOL-PACKAGE)
	(* * External interface)
	(MACROS DO-ALL-SYMBOLS DO-EXTERNAL-SYMBOLS DO-SYMBOLS)
	(FNS EXPORT FIND-ALL-SYMBOLS FIND-PACKAGE FIND-SYMBOL IMPORT IN-PACKAGE INTERN 
	     LIST-ALL-PACKAGES MAKE-PACKAGE RENAME-PACKAGE SHADOW SHADOWING-IMPORT UNEXPORT UNINTERN 
	     UNUSE-PACKAGE USE-PACKAGE)
	(* * And the FNS: PACKAGE-NAME PACKAGE-NICKNAMES PACKAGE-SHADOWING-SYMBOLS PACKAGE-USE-LIST 
	   PACKAGE-USED-BY-LIST)
	(* * Internal interface)
	(RECORDS PACKAGE SYMBOL)
	(INITVARS (PKG::ALL-PACKAGES NIL)
		  (PKG::KEYWORD-PACKAGE NIL)
		  (PKG::INDEX-TO-PACKAGE-VECTOR NIL)
		  (PKG::PACKAGE-TO-INDEX-HASHTABLE NIL))
	(MACROS PKG::LISTIFY PKG::PACKAGIFY)
	(FNS PKG::INITIALIZE PKG::FIND-INHERITED-SYMBOL PKG::STRINGIFY PKG::FIND-FREE-PACKAGE-INDEX 
	     ADD-NICKNAMES)
	(P (PKG::INITIALIZE))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
		  (ADDVARS (NLAMA)
			   (NLAML)
			   (LAMA USE-PACKAGE UNUSE-PACKAGE UNINTERN UNEXPORT SHADOWING-IMPORT SHADOW 
				 RENAME-PACKAGE INTERN IN-PACKAGE IMPORT FIND-SYMBOL EXPORT 
				 MAKE-PACKAGE])
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 USE-PACKAGE UNUSE-PACKAGE UNINTERN UNEXPORT SHADOWING-IMPORT SHADOW RENAME-PACKAGE 
			     INTERN IN-PACKAGE IMPORT FIND-SYMBOL EXPORT MAKE-PACKAGE)
)
(PUTPROPS CMLPACKAGE COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2406 2864 (SYMBOL-PACKAGE 2416 . 2616) (SETF-SYMBOL-PACKAGE 2618 . 2862)) (3061 8007 (
EXPORT 3071 . 3133) (FIND-ALL-SYMBOLS 3135 . 3198) (FIND-PACKAGE 3200 . 3383) (FIND-SYMBOL 3385 . 3849
) (IMPORT 3851 . 3913) (IN-PACKAGE 3915 . 4202) (INTERN 4204 . 5101) (LIST-ALL-PACKAGES 5103 . 5368) (
MAKE-PACKAGE 5370 . 6222) (RENAME-PACKAGE 6224 . 6634) (SHADOW 6636 . 6698) (SHADOWING-IMPORT 6700 . 
6772) (UNEXPORT 6774 . 6838) (UNINTERN 6840 . 7538) (UNUSE-PACKAGE 7540 . 7619) (USE-PACKAGE 7621 . 
8005)) (9717 11494 (PKG::INITIALIZE 9727 . 10290) (PKG::FIND-INHERITED-SYMBOL 10292 . 10737) (
PKG::STRINGIFY 10739 . 10924) (PKG::FIND-FREE-PACKAGE-INDEX 10926 . 11166) (ADD-NICKNAMES 11168 . 
11492)))))
STOP