;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Written 04/28/89 08:49:18 by SWEDE, ;;; Reason: fix common-lisp package ;;; while running on Newton from band LOD4 ;;; With Experimental REL6H 1.0, Experimental SYSTEM 6.0, Experimental VIRTUAL-MEMORY 6.0, ;;; Experimental EH 6.0, Experimental MAKE-SYSTEM 6.0, Experimental MICRONET 6.0, ;;; Experimental LOCAL-FILE 6.0, Experimental BASIC-PATHNAME 6.0, Experimental NETWORK-SUPPORT-COLD 6.0, ;;; Experimental BASIC-NAMESPACE 6.0, Experimental NETWORK-NAMESPACE 6.0, Experimental DISK-IO 6.0, ;;; Experimental DISK-LABEL 6.0, Experimental BASIC-FILE 6.0, Experimental MAC-PATHNAME 6.0, ;;; Experimental NETWORK-PATHNAME 6.0, Experimental COMPILER 6.0, Experimental TV 6.0, ;;; Experimental DATALINK 6.0, Experimental CHAOSNET 6.0, Experimental GC 6.0, Experimental MEMORY-AUX 6.0, ;;; Experimental NVRAM 6.0, Experimental SYSLOG 6.0, Experimental STREAMER-TAPE 6.0, ;;; Experimental CLEH 1.0, Experimental UCL 6.0, Experimental INPUT-EDITOR 6.0, Experimental METER 6.0, ;;; Experimental ZWEI 6.0, Experimental DEBUG-TOOLS 6.0, Experimental NETWORK-SUPPORT 6.0, ;;; Experimental NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0, microcode 423, Band Name: 6.0 dev2 4/28 #!C ; From file INITIAL-PACKAGES.LISP#> KERNEL; Newton: #10R SYSTEM#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; INITIAL-PACKAGES.#" (Defconstant INITIAL-PACKAGES '( ("KEYWORD" . (:NICKNAMES ("") :SIZE 5000. :USE NIL :AFTER-INTERN-DAEMON EXTERNALIZE-ALL-SYMBOLS :Prefix-Name "")) ("LISP" . (:NICKNAMES ("CLI" "COMMON-LISP-INCOMPATIBLE" "COMMON-LISP-GLOBAL") ;jlm 4/24/89 :SIZE 800. :USE ("TICL") :PREFIX-NAME "LISP")) ("COMMON-LISP" . (:NICKNAMES ("CL") :USE nil :size 800. :PREFIX-NAME "COMMON-LISP")) ("TICL" . (:NICKNAMES ("EECL") :SIZE 719. :USE NIL)) ("SYSTEM" . (:NICKNAMES ("SYS" "SI" "SYSTEM-INTERNALS") :SIZE 11273. :PREFIX-NAME "SYS" :AREA NR-SYM)) ("ZLC" . (:SIZE 307. :USE ("LISP" "TICL") :Prefix-Name "ZLC")) ("GLOBAL" . (:NICKNAMES ("ZETALISP" "ZL" "ZETALISP-GLOBAL") :SIZE 1973. :USE NIL :Prefix-Name "GLOBAL")) ("COMPILER" . (:SIZE 2800. :NICKNAMES ("COMPILER2") :USE ("ZLC" "TICL" "LISP" "SYS") :AREA NR-SYM :Prefix-Name "COMPILER")) ("USER" . (:SIZE 2000. :USE ("ZLC" "TICL" "LISP") :Prefix-Name "USER" :AREA NR-SYM)) ("COMMON-LISP-USER" . (:NICKNAMES ("CL-USER") :SIZE 2000. :USE ("COMMON-LISP") :PREFIX-NAME "CL-USER" :AREA NR-SYM)) ("FORMAT" . (:size 400 :use ("LISP" "TICL") :Prefix-Name "FORMAT" :AREA NR-SYM)) ("FILE-SYSTEM" . (:SIZE 2500. :USE ("SYS" "TICL" "LISP") :NICKNAMES ("FS") :PREFIX-NAME "FS")) ("TV" . (:SIZE 4500. :USE ("LISP" "TICL" "SYS") :Prefix-Name "TV" :AREA NR-SYM)) ("W" . (:SIZE 1000. :USE ("LISP" "TICL" "SYS" "TV") :Prefix-Name "W")) ("EH" . (:SIZE 1500. :USE ("LISP" "TICL" "SYS") :NICKNAMES ("DBG" "DEBUGGER") :Prefix-Name "EH" :AREA NR-SYM)) ("TIME" . (:SIZE 1000. :Prefix-Name "TIME")) ("FONTS" . (:AUTO-EXPORT-P T :USE ("LISP" "TICL") :Prefix-Name "FONTS" :SHADOW ("SEARCH"))) ("MATH" . (:SIZE 150. :Prefix-Name "MATH")) ("NAME" . (:SIZE 1500. :USE ("TICL" "LISP") :Prefix-Name "NAME")) ;;("HOST" . (:SIZE 1500. :USE ("TICL" "LISP") :Prefix-Name "HOST")) ;;("NET-CONFIG" . (:USE ("SYS" "TICL" "LISP") :Prefix-Name "NET-CONFIG")) ("NET" . (:SIZE 1000. :USE ("SYS" "TICL" "LISP") :Prefix-Name "NET" :NICKNAMES ("HOST"))) ("ZWEI" . (:USE ("LISP" "TICL") :SIZE 6400. :Prefix-Name "ZWEI")) ("MICRONET" . (:size 450 :use ("TICL" "LISP" "SYSTEM") :nicknames ("ADDIN" "ADD" "AC" "ADDIN-COMM") :prefix-name "ADD")) ("TICLOS" :size 1260 :use ("TICL" "LISP") :prefix-name "TICLOS") ("CLOS" :size 166 :use ("LISP") :prefix-name "CLOS") )) )) #!C ; From file VARIABLE-DEFINITIONS.LISP#> KERNEL; Newton: #10R SYSTEM#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; VARIABLE-DEFINITIONS.#" (Defvar *COMMON-LISP-PACKAGE* NIL "The True Common Lisp package") )) #!C ; From file VARIABLE-DEFINITIONS.LISP#> KERNEL; Newton: #10R SYSTEM#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; VARIABLE-DEFINITIONS.#" (Defvar *COMMON-LISP-USER-PACKAGE* nil "The default package for common-lisp user code") )) #!C ; From file PACKAGE-INITIALIZE.LISP#> KERNEL; Newton: #10R SYSTEM#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; PACKAGE-INITIALIZE.#" (Defun PKG-INITIALIZE () (DECLARE (SPECIAL *PACKAGE-HASH-TABLE* *INITIAL-COMMON-LISP-SYMBOLS* *INITIAL-TICL-SYMBOLS* *INITIAL-ZLC-SYMBOLS* *EXTERNAL-ZLC-SYMBOLS* *EXTERNAL-SYSTEM-SYMBOLS*)) (SETQ *PACK-BAD-SYMBOLS* NIL *SYMBOLS-SEEN-TWICE* NIL *MULTIPLE-SYMBOL-BLOCKS* NIL) (SETQ *PACKAGE-HASH-TABLE* (MAKE-ARRAY *package-hash-table-size* :AREA pkg-area )) (make-named-package "KEYWORD" '*KEYWORD-PACKAGE*) (make-named-package "TICL" '*TICL-PACKAGE*) ;Must make TICL before LISP (make-named-package "LISP" '*LISP-PACKAGE*) (make-named-package "COMMON-LISP" '*COMMON-LISP-PACKAGE*) (make-named-package "SYSTEM" '*SYSTEM-PACKAGE*) (make-named-package "ZLC" '*ZLC-PACKAGE*) (make-named-package "GLOBAL" '*GLOBAL-PACKAGE*) (make-named-package "COMPILER" 'PKG-COMPILER-PACKAGE) (make-named-package "USER" '*USER-PACKAGE*) (make-named-package "COMMON-LISP-USER" '*COMMON-LISP-USER-PACKAGE*) ;; Intern the LISP, TICL, and ZLC symbols. (DOLIST (SYM *INITIAL-COMMON-LISP-SYMBOLS*) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT SYM *LISP-PACKAGE* T)) (DOLIST (SYM *INITIAL-COMMON-LISP-SYMBOLS*) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT SYM *COMMON-LISP-PACKAGE* T)) (DOLIST (SYM *INITIAL-TICL-SYMBOLS*) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT SYM *TICL-PACKAGE* T)) (DOLIST (SYM *INITIAL-ZLC-SYMBOLS*) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT SYM *ZLC-PACKAGE* NIL)) (BOOTSTRAP-EXPORT *EXTERNAL-ZLC-SYMBOLS* *ZLC-PACKAGE*) ;; export (SETF (PACK-SHADOWING-SYMBOLS *ZLC-PACKAGE*) 'ZLC:(/ *DEFAULT-PATHNAME-DEFAULTS* APPLYHOOK AR-1 AR-1-FORCE AREF ASSOC ATAN CHARACTER CLOSE DEFSTRUCT DELETE EVAL EVALHOOK EVERY FLOAT FORMAT INTERSECTION LAMBDA LISTP MAKE-HASH-TABLE MAKE-INSTANCE MAP MEMBER NAMED-LAMBDA NAMED-SUBST NINTERSECTION NLISTP NUNION PACKAGE RASSOC READ READ-FROM-STRING READTABLE REM REMOVE SOME STRING SUBST TERPRI UNION)) ;; Set up the GLOBAL package. (dolist (pkg '(ticl lisp)) (do-external-symbols (sym pkg) (unless (assoc sym *zetalisp-symbol-substitutions* :test #'eq) (bootstrap-intern-and-optionally-export sym *global-package* t)))) (do-local-symbols (sym 'zlc t) (bootstrap-intern-and-optionally-export sym *global-package* t)) (DOLIST (elem initial-packages) (unless (find-package (car elem)) (APPLY #'MAKE-PACKAGE (car elem)(cdr elem)))) ;; We have packages!! (SETQ *PACKAGE* *USER-PACKAGE*) ;; Put system variables and system constants in the SYSTEM package ;; (unless they are already in the LISP or TICL package). (DOLIST (LIST SYSTEM-VARIABLE-LISTS) (DOLIST (VAR (SYMBOL-VALUE LIST)) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT VAR *SYSTEM-PACKAGE* T))) (DOLIST (LIST SYSTEM-CONSTANT-LISTS) (DOLIST (VAR (SYMBOL-VALUE LIST)) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT VAR *SYSTEM-PACKAGE* T))) (DOLIST (VAR A-MEMORY-COUNTER-BLOCK-NAMES) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT VAR *SYSTEM-PACKAGE* T)) (SETQ *PKG-HACK* NIL) ;; **** DEBUG ;; Now all other system symbols go in the SYSTEM package, unless the cold-load ;; has specified a different place for them to go. Symbols shared among various ;; systems programs are made external, while all the others remain internal. (MAPATOMS-NR-SYM #'(LAMBDA (SYM &AUX PKG PKG1) (UNLESS (PACKAGEP (SETQ PKG1 (SYMBOL-PACKAGE SYM))) ;already interned on a package (UNLESS (ASSOC PKG1 *PKG-HACK* :TEST #'EQ) (PUSH (CONS PKG1 SYM) *PKG-HACK*)) (SETF (SYMBOL-PACKAGE SYM) NIL) (SETQ PKG (OR (AND PKG1 (OR (FIND-PACKAGE PKG1) (MAKE-PACKAGE PKG1))) *SYSTEM-PACKAGE*)) (WHEN (EQ PKG *KEYWORD-PACKAGE*) (SET SYM SYM)) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT SYM PKG)))) (BOOTSTRAP-EXPORT *EXTERNAL-SYSTEM-SYMBOLS* *SYSTEM-PACKAGE*) (SETQ ARRAY-TYPE-KEYWORDS (LOOP FOR A IN ARRAY-TYPES COLLECT (INTERN (STRING A) *KEYWORD-PACKAGE*))) ;; Must SHADOW after BOOTSTRAP-INTERN to prevent allocation of multiple symbol blocks - JK (shadow "ARG" 'eh) (locate-dup-symbols) T) )) (in-package 'sys) (when (find-package 'cl-user) (delete-package 'cl-user)) (when (find-package 'cl) (delete-package 'cl)) (make-named-package "COMMON-LISP" '*COMMON-LISP-PACKAGE*) (make-named-package "COMMON-LISP-USER" '*COMMON-LISP-USER-PACKAGE*) (DOLIST (SYM *INITIAL-COMMON-LISP-SYMBOLS*) (BOOTSTRAP-INTERN-AND-OPTIONALLY-EXPORT SYM *COMMON-LISP-PACKAGE* T))