;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*-

;;; Reason: Recreate the common-lisp-readtable from scratch whenever we do a 
;;; (COPY-READTABLE NIL), instead of using the global value
;;; of common-lisp-readtable [spr 9482].

;;;                           RESTRICTED RIGHTS LEGEND
;;;
;;; Use, duplication, or disclosure by the Government is subject to
;;; restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;; Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;   TEXAS INSTRUMENTS INCORPORATED      
;;;   P.O. BOX 2909, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Written 06/27/89 08:48:13 by MCCREARY,
;;; while running on Jules-Verne from band LOD9
;;; With SYSTEM 6.9, VIRTUAL-MEMORY 6.1, EH 6.3, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.0, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.1, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.0, DISK-LABEL 6.0, BASIC-FILE 6.2, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.6, TV 6.11, DATALINK 6.0, CHAOSNET 6.0, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.1,
;;;  SYSLOG 6.1, STREAMER-TAPE 6.3, UCL 6.0, INPUT-EDITOR 6.0, METER 6.0, ZWEI 6.3,
;;;  DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.0, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.1, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.0,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.0, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.2, Inconsistent TI-CLOS 6.11, CLEH 6.4,
;;;  IP 3.47, Experimental BUG 11.10, Experimental CLX 6.1, CLUE 6.5, X11M 6.1,  microcode 429,
;;;  Band Name: Release 6.0 + SLE 6/5

#!C
; From file READTABLE-FUNCTIONS.LISP#> KERNEL; MR-X:
#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; READTABLE-FUNCTIONS.#"


(defun copy-readtable (&optional (from-readtable *readtable*) to-readtable)
  ;; 06/27/89 clm - Recreate the common-lisp-readtable whenever we do a 
  ;;                (COPY-READTABLE NIL), instead of using the global value
  ;;                of common-lisp-readtable.  If the common-lisp-readtable
  ;;                had been modified, there was no way to get a copy of the
  ;;                original again [spr 9482].
  (if (null from-readtable) (setq from-readtable (init-std-lisp-readtable) ))	   ; clm 06/26/89 
  (if (null to-readtable) (setq to-readtable (make-readtable)))
  ;;physically clobber contents of internal tables.
  (replace (character-attribute-table to-readtable)
	   (character-attribute-table from-readtable))
  (replace (character-macro-table to-readtable)
	   (character-macro-table from-readtable))
  ;; Preserve the printslots for Zetalisp.
  (setf (pttbl-character-prefix  to-readtable)
	   (pttbl-character-prefix  from-readtable))
  (setf (pttbl-slash  to-readtable)
	   (pttbl-slash  from-readtable))
  (setf (pttbl-rational-infix to-readtable)
	   (pttbl-rational-infix from-readtable))
  (setf (dispatch-tables to-readtable)
	(mapcar #'(lambda (pair) (cons (car pair)
				       (copy-seq (cdr pair))))
		(dispatch-tables from-readtable)))
  to-readtable)
))