;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-
;;; Written 07/14/89 16:32:22 by SWEDE,
;;; Reason: Fix Symbols PACKAGE READTABLE EVALHOOK APPLYHOOK to look at correct LISP values (*PACKAGE*, *READTABLE*, etc.) 
;;; also fixes SPR # 10275.   
;;; while running on ERIK from band LODX
;;; With SYSTEM 6.0, VIRTUAL-MEMORY 6.0, EH 6.0, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.0, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.0, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.0, TV 6.0, DATALINK 6.0, CHAOSNET 6.0, GC 6.0, MEMORY-AUX 6.0, NVRAM 6.0,
;;;  SYSLOG 6.0, STREAMER-TAPE 6.0, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.0,
;;;  DEBUG-TOOLS 6.0, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.0, SERIAL 6.0, PRINTER 6.0, MAC-PRINTER-TYPES 6.0, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.0, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.0, VISIDOC 6.0, TI-CLOS 6.0, CLEH 6.0,  microcode 596,
;;;  Band Name: Release 6.0 - 5/19

#!C
; From file SYMBOLS.LISP#> KERNEL; MR-X:
#10R USER#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: KERNEL; INITIAL-PACKAGES-MX.#"


(eval-when (eval load)
  (let ((sym (find-symbol "PACKAGE" 'lisp)))
    (unless (and (boundp sym)
		 (eq (symbol-value sym) (symbol-value 'lisp:*package*)))
      (si:%p-store-data-type-and-pointer
	(si:%pointer (locf (symbol-value sym)))
	si:dtp-one-q-forward
	(value-cell-location 'LISP:*PACKAGE*)))
    (unless (eq (si:%p-cdr-code (si:%pointer (locf (symbol-value sym)))) si:cdr-next)
      (si:%p-store-cdr-code (si:%pointer (locf (symbol-value sym))) si:cdr-next))
    (unless (eq (find-symbol "PACKAGE" 'global)
		(find-symbol "PACKAGE" 'ZLC))
      (unexport (find-symbol "PACKAGE" 'global) 'global)
      (unintern (find-symbol "PACKAGE" 'global) 'global)
      (export (find-symbol "PACKAGE" 'ZLC) 'global)))
  
  (let ((sym (find-symbol "READTABLE" 'lisp)))
    (unless (and (boundp sym)
		 (eq (symbol-value sym) (symbol-value 'LISP:*READTABLE*)))
      (si:%p-store-data-type-and-pointer
	(si:%pointer (locf (symbol-value sym)))
	si:dtp-one-q-forward
	(value-cell-location 'LISP:*READTABLE*)))
    (unless (eq (si:%p-cdr-code (si:%pointer (locf (symbol-value sym)))) si:cdr-next)
      (si:%p-store-cdr-code (si:%pointer (locf (symbol-value sym))) si:cdr-next))
    (unless (eq (find-symbol "READTABLE" 'global)
		(find-symbol "READTABLE" 'ZLC))
      (unexport (find-symbol "READTABLE" 'global) 'global)
      (unintern (find-symbol "READTABLE" 'global) 'global)
      (export (find-symbol "READTABLE" 'ZLC) 'global)))
  
  (let ((sym (find-symbol "APPLYHOOK" 'lisp)))
    (unless (and (boundp sym)
		 (eq (symbol-value sym) (symbol-value 'LISP:*APPLYHOOK*)))
      (si:%p-store-data-type-and-pointer
	(si:%pointer (locf (symbol-value sym)))
	si:dtp-one-q-forward
	(value-cell-location 'LISP:*APPLYHOOK*)))
    (unless (eq (si:%p-cdr-code (si:%pointer (locf (symbol-value sym)))) si:cdr-next)
      (si:%p-store-cdr-code (si:%pointer (locf (symbol-value sym))) si:cdr-next))
    (unless (eq (find-symbol "APPLYHOOK" 'global)
		(find-symbol "APPLYHOOK" 'ZLC))
      (unexport (find-symbol "APPLYHOOK" 'global) 'global)
      (unintern (find-symbol "APPLYHOOK" 'global) 'global)
      (export (find-symbol "APPLYHOOK" 'ZLC) 'global)))
  
  (let ((sym (find-symbol "EVALHOOK" 'lisp)))
    (unless (and (boundp sym)
		 (eq (symbol-value sym) (symbol-value 'LISP:*EVALHOOK*)))
      (si:%p-store-data-type-and-pointer
	(si:%pointer (locf (symbol-value sym)))
	si:dtp-one-q-forward
	(value-cell-location 'LISP:*EVALHOOK*)))
    (unless (eq (si:%p-cdr-code (si:%pointer (locf (symbol-value sym)))) si:cdr-next)
      (si:%p-store-cdr-code (si:%pointer (locf (symbol-value sym))) si:cdr-next))
    (unless (eq (find-symbol "EVALHOOK" 'global)
		(find-symbol "EVALHOOK" 'ZLC))
      (unexport (find-symbol "EVALHOOK" 'global) 'global)
      (unintern (find-symbol "EVALHOOK" 'global) 'global)
      (export (find-symbol "EVALHOOK" 'ZLC) 'global))
    ))
))