(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE (DEFPACKAGE "CONDITIONS" (USE "COMMON-LISP")))

(IL:FILECREATED " 6-Apr-92 19:39:50" IL:{DSK}<usr>local>lde>lispcore>sources>CONDITION-PACKAGE.;9
 6885   

      IL:changes IL:to%:  (IL:VARS IL:CONDITION-PACKAGECOMS)
                          (IL:VARIABLES *FUTURE-CITIZENS-OF-CONDITIONS*)

      IL:previous IL:date%: "17-Mar-92 18:47:01" 
IL:{DSK}<usr>local>lde>lispcore>sources>CONDITION-PACKAGE.;8)


(IL:* ; "
Copyright (c) 1987, 1988, 1900, 1990, 1992 by Venue & Xerox Corporation.  All rights reserved.
")

(IL:PRETTYCOMPRINT IL:CONDITION-PACKAGECOMS)

(IL:RPAQQ IL:CONDITION-PACKAGECOMS
 
          ((IL:FUNCTIONS CL::NATURALIZE CL::REHOME-SYMBOL DEFECT-FROM-XCL-TO-CONDITIONS)
           (IL:VARIABLES *FUTURE-CITIZENS-OF-CONDITIONS*)
           (IL:DECLARE%: IL:DONTEVAL@LOAD IL:DOCOPY
                  (IL:P (DEFPACKAGE "CONDITIONS" (:USE "COMMON-LISP")
                               (:EXPORT "*BREAK-ON-SIGNALS*" "COMPUTE-RESTARTS" "CONTINUE" 
                                      "DIVISION-BY-ZERO" "FILE-ERROR" "FILE-ERROR-PATHNAME" 
                                      "FIND-RESTART" "FLOATING-POINT-INEXACT" 
                                      "FLOATING-POINT-INVALID-OPERATION" "FLOATING-POINT-OVERFLOW" 
                                      "FLOATING-POINT-UNDERFLOW" "HANDLER-CASE" "INVOKE-DEBUGGER" 
                                      "INVOKE-RESTART" "INVOKE-RESTART-INTERACTIVELY" 
                                      "MUFFLE-WARNING" "PARSE-ERROR" "PROGRAM-ERROR" "READER-ERROR" 
                                      "RESTART" "RESTART-BIND" "RESTART-CASE" "RESTART-NAME" 
                                      "STYLE-WARNING" "TYPE-ERROR-DATUM" "UNBOUND-SLOT" 
                                      "WITH-SIMPLE-RESTART" "WITH-CONDITION-RESTARTS"))
                        (MAPC #'DEFECT-FROM-XCL-TO-CONDITIONS *FUTURE-CITIZENS-OF-CONDITIONS*)))
           (IL:PROP (IL:FILETYPE IL:MAKEFILE-ENVIRONMENT)
                  IL:CONDITION-PACKAGE)))

(DEFUN CL::NATURALIZE
 (CL::NAME CL::SOURCE CL::DESTINATION)

                                                        (IL:* IL:; "Edited 17-Mar-92 18:45 by jrb:")


   (IL:* IL:;; "Make a symbol, possibly in source, be in source and citizen and export of destination.  Don't move it if it's currently in COMMON-LISP")


   (CHECK-TYPE CL::NAME STRING)
   (CHECK-TYPE CL::SOURCE PACKAGE)
   (CHECK-TYPE CL::DESTINATION PACKAGE)
   [MULTIPLE-VALUE-BIND (CL::CLSYMBOL CL::CLWHERE)
          (FIND-SYMBOL CL::NAME IL:*COMMON-LISP-PACKAGE*)
          (IF CL::CLSYMBOL
              (PROGN (IMPORT CL::CLSYMBOL CL::SOURCE)
                     (IMPORT CL::CLSYMBOL CL::DESTINATION)
                     (EXPORT CL::CLSYMBOL CL::DESTINATION))
              [MULTIPLE-VALUE-BIND (CL::SSYMBOL CL::SWHERE)
                     (FIND-SYMBOL CL::NAME CL::SOURCE)
                     (MULTIPLE-VALUE-BIND (CL::DSYMBOL CL::DWHERE)
                            (FIND-SYMBOL CL::NAME CL::DESTINATION)
                            (COND
                               ((AND CL::SWHERE CL::DWHERE (NOT (EQ CL::SSYMBOL CL::DSYMBOL)))
                                (ERROR "Can't naturalize ~s because name exists in ~s and ~s" 
                                       CL::NAME (PACKAGE-NAME CL::SOURCE)
                                       (PACKAGE-NAME CL::DESTINATION)))
                               (CL::SWHERE (IMPORT CL::SSYMBOL CL::DESTINATION)
                                      (EXPORT CL::SSYMBOL CL::DESTINATION)
                                      (CL::REHOME-SYMBOL
 CL::SSYMBOL CL::DESTINATION))
                               (CL::DWHERE (IMPORT CL::DSYMBOL CL::SOURCE)
                                      (CL::REHOME-SYMBOL
 CL::DSYMBOL CL::DESTINATION))
                               (T (LET ((SYMBOL (INTERN CL::NAME CL::DESTINATION)))
                                       (IMPORT SYMBOL CL::SOURCE)
                                       (EXPORT SYMBOL CL::DESTINATION])]
   T)

(DEFUN CL::REHOME-SYMBOL
 (CL::S CL::NEW-HOME)
   (IL:* IL:; "Edited 17-Mar-92 15:35 by jrb:")


   (IL:* IL:;; "This must be done carefully if the symbol currently names a type; the type-variable must be shared between the old and new packages")


   (WHEN (LISP::PARSED-STRUCTURE CL::S T)
       (LET ((CL::TV (IL:TYPE-VARIABLE-FROM-TYPE-NAME CL::S)))
            (IMPORT CL::TV CL::NEW-HOME)
            (SETF (SYMBOL-PACKAGE CL::TV)
                  CL::NEW-HOME)))
   (IMPORT CL::S CL::NEW-HOME)
   (EXPORT CL::S CL::NEW-HOME)
   (SETF (SYMBOL-PACKAGE CL::S)
         CL::NEW-HOME))

(DEFUN DEFECT-FROM-XCL-TO-CONDITIONS
 (NAME)
   (CL::NATURALIZE
 NAME (FIND-PACKAGE "XCL")
          (FIND-PACKAGE "CONDITIONS")))

(XCL:DEFGLOBALPARAMETER *FUTURE-CITIZENS-OF-CONDITIONS*

   '("ABORT" "ARITHMETIC-ERROR" "ARITHMETIC-ERROR-OPERANDS" "ARITHMETIC-ERROR-OPERATION" "CELL-ERROR"
           "CELL-ERROR-NAME" "CONDITION" "CONTROL-ERROR" "DEFINE-CONDITION" "END-OF-FILE" 
           "HANDLER-BIND" "HANDLER-CASE" "IGNORE-ERRORS" "MAKE-CONDITION" "SERIOUS-CONDITION" 
           "SIGNAL" "SIMPLE-CONDITION" "SIMPLE-CONDITION-FORMAT-ARGUMENTS" 
           "SIMPLE-CONDITION-FORMAT-STRING" "SIMPLE-ERROR" "SIMPLE-TYPE-ERROR" "SIMPLE-WARNING" 
           "STORAGE-CONDITION" "STORE-VALUE" "STREAM-ERROR" "STREAM-ERROR-STREAM" "TYPE-ERROR" 
           "TYPE-ERROR-EXPECTED-TYPE" "UNBOUND-VARIABLE" "UNDEFINED-FUNCTION" "USE-VALUE" "WARNING")
   "Current citizens of XCL that should be in CONDITIONS: do not change this list!!!")
(IL:DECLARE%: IL:DONTEVAL@LOAD IL:DOCOPY 

(DEFPACKAGE "CONDITIONS" (:USE "COMMON-LISP")
       (:EXPORT "*BREAK-ON-SIGNALS*" "COMPUTE-RESTARTS" "CONTINUE" "DIVISION-BY-ZERO" "FILE-ERROR" 
              "FILE-ERROR-PATHNAME" "FIND-RESTART" "FLOATING-POINT-INEXACT" 
              "FLOATING-POINT-INVALID-OPERATION" "FLOATING-POINT-OVERFLOW" "FLOATING-POINT-UNDERFLOW"
              "HANDLER-CASE" "INVOKE-DEBUGGER" "INVOKE-RESTART" "INVOKE-RESTART-INTERACTIVELY" 
              "MUFFLE-WARNING" "PARSE-ERROR" "PROGRAM-ERROR" "READER-ERROR" "RESTART" "RESTART-BIND"
              "RESTART-CASE" "RESTART-NAME" "STYLE-WARNING" "TYPE-ERROR-DATUM" "UNBOUND-SLOT" 
              "WITH-SIMPLE-RESTART" "WITH-CONDITION-RESTARTS"))

(MAPC #'DEFECT-FROM-XCL-TO-CONDITIONS *FUTURE-CITIZENS-OF-CONDITIONS*)
)

(IL:PUTPROPS IL:CONDITION-PACKAGE IL:FILETYPE
 IL:COMPILE-FILE)

(IL:PUTPROPS IL:CONDITION-PACKAGE IL:MAKEFILE-ENVIRONMENT
 (:READTABLE "INTERLISP" :PACKAGE
                                                                     (DEFPACKAGE "CONDITIONS"
                                                                            (:USE "COMMON-LISP"))))
(IL:PUTPROPS IL:CONDITION-PACKAGE IL:COPYRIGHT ("Venue & Xerox Corporation" 1987 1988 1900 1990 1992))
(IL:DECLARE%: IL:DONTCOPY
  (IL:FILEMAP (NIL)))
IL:STOP