(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