initial checkin for sources

sources/AERROR

@@ -0,0 +1 @@
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-May-90 11:58:35" {DSK}<usr>local>lde>lispcore>sources>AERROR.;2
 10460        changes to%:  (VARS AERRORCOMS)      previous date%: " 1-Feb-89 09:38:44" {DSK}<usr>local>lde>lispcore>sources>AERROR.;1)(* ; "Copyright (c) 1982, 1983, 1986, 1987, 1988, 1989, 1990 by Venue & Xerox Corporation.  All rights reserved.")(PRETTYCOMPRINT AERRORCOMS)(RPAQQ AERRORCOMS
       ((FNS ERRORSTRING SETERRORN LISPERROR \LISPERROR \ILLEGAL.ARG \ARG.NOT.LITATOM)        (EXPORT (DECLARE%: EVAL@COMPILE (VARS \ERRORMESSAGELIST)                       DONTCOPY                       (OPTIMIZERS LISPERROR)))        (VARIABLES *LAST-CONDITION*)        (GLOBALVARS \ERRORMESSAGELIST)        (FUNCTIONS ERRM-TO-CONDITION)        (PROP FILETYPE AERROR)        (LOCALVARS . T)))(DEFINEQ(ERRORSTRING
(LAMBDA (X) (* lmm "21-APR-80 15:46") (CAR (NTH \ERRORMESSAGELIST (ADD1 (OR (NUMBERP X) 17))))))(SETERRORN
(LAMBDA (NUM MESS) (* amd "30-Jul-86 17:00") (CL:SETQ *LAST-CONDITION* (ERRM-TO-CONDITION NUM MESS))))(LISPERROR
  [LAMBDA (N X CONTINUEOKFLG)
                            (* ; "Edited  1-Feb-89 09:38 by jds")
    (* ;; "compiles open as call to \LISPERROR")
    [COND       ((STRINGP N)        (* ;; "Case where LISPERROR is called with one of the %"canonical error message%" strings from the old IL implementation.  Need to translate it to a number.  THIS CODE IS STOLEN IN SPIRIT FROM THE OPTIMIZER.")
        (FOR
 MSG IN
 \ERRORMESSAGELIST AS
 I FROM
 0 WHEN
 (CL:EQUAL MSG N)           DO
 (SETQ N I]    (\LISPERROR
 X N CONTINUEOKFLG])(\LISPERROR
(LAMBDA (X N CONTINUEOKFLG) (* amd "11-Nov-86 12:09") (DECLARE (USEDFREE \INTERRUPTABLE)) (PROG NIL (SELECTQ N ((5 22) (* ; "File errors that can happen to files open for output") (* ;; "(\STOP.DRIBBLE?  X)")) NIL) (OR \INTERRUPTABLE (\MP.ERROR \MP.UNINTERRUPTABLE "Error in uninterruptable system code -- ^N to continue into error handler" X)) RET (RETURN (PROG1 (COND ((SMALLP N) (ERRORX (LIST N X))) (T (ERROR N X))) (OR CONTINUEOKFLG (GO RET)))))))(\ILLEGAL.ARG
(LAMBDA (X) (* lmm "25-APR-80 18:02") (LISPERROR "ILLEGAL ARG" X)))(\ARG.NOT.LITATOM
(LAMBDA (X) (* lmm "25-APR-80 18:02") (LISPERROR "ARG NOT LITATOM" X))))(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE (RPAQQ \ERRORMESSAGELIST
       ("SYSTEM ERROR" " " "STACK OVERFLOW" "ILLEGAL RETURN" "ARG NOT LIST" "HARD DISK ERROR"               "ATTEMPT TO SET NIL OR T" "ATTEMPT TO RPLAC NIL" "UNDEFINED OR ILLEGAL GO"               "FILE WON'T OPEN" "NON-NUMERIC ARG" "ATOM TOO LONG" "ATOM HASH TABLE FULL"               "FILE NOT OPEN" "ARG NOT LITATOM" "! too many files open" "END OF FILE" "ERROR" "BREAK"              "ILLEGAL STACK ARG" "FAULT IN EVAL" "ARRAYS FULL" "FILE SYSTEM RESOURCES EXCEEDED"               "FILE NOT FOUND" "BAD SYSOUT FILE" "UNUSUAL CDR ARG LIST" "HASH TABLE FULL"               "ILLEGAL ARG" "ARG NOT ARRAY" "ILLEGAL OR IMPOSSIBLE BLOCK"               "STACK PTR HAS BEEN RELEASED" "STORAGE FULL" "ATTEMPT TO USE ITEM OF INCORRECT TYPE"               "ILLEGAL DATA TYPE NUMBER" "DATA TYPES FULL" "ATTEMPT TO BIND NIL OR T"               "! too many user interrupt characters" "! read-macro context error" "ILLEGAL READTABLE"              "ILLEGAL TERMINAL TABLE" "! swapblock too big for buffer" "PROTECTION VIOLATION"               "BAD FILE NAME" "USER BREAK" "UNBOUND ATOM" "UNDEFINED CAR OF FORM"               "UNDEFINED FUNCTION" "CONTROL-E" "FLOATING UNDERFLOW" "FLOATING OVERFLOW" "OVERFLOW"               "ARG NOT HARRAY" "TOO MANY ARGUMENTS"))DONTCOPY (DEFOPTIMIZER LISPERROR
 (MESSAGE ARG)                            `(\LISPERROR
 ,ARG                                    ,(CL:IF (CL:STRINGP MESSAGE)                                         [FOR
 X IN
 \ERRORMESSAGELIST AS
 I FROM
 0                                            WHEN
 (CL:EQUAL X MESSAGE) DO
 (RETURN I)                                            FINALLY
 (RETURN (HELP "Unknown error message"                                                                      (LIST MESSAGE ARG]                                         MESSAGE))))(* "END EXPORTED DEFINITIONS")(CL:DEFVAR *LAST-CONDITION*
 NIL   "Last condition signalled. This gets rebound to itself in nested execs.")(DECLARE%: DOEVAL@COMPILE DONTCOPY(GLOBALVARS \ERRORMESSAGELIST))(CL:DEFUN ERRM-TO-CONDITION
 (NUM MESSAGE)   (CL:IF (TYPEP NUM 'CONDITION)       NUM       (CASE NUM           (2                                                (* ; "STACK OVERFLOW")
              (MAKE-CONDITION 'STACK-OVERFLOW))           (3                                                (* ; "ILLEGAL RETURN")
              (MAKE-CONDITION 'ILLEGAL-RETURN :TAG MESSAGE))           ((4 10 14 28 38 39 51)                            (* ; "ARG NOT x")
              [MAKE-CONDITION 'XCL:TYPE-MISMATCH :NAME MESSAGE :VALUE MESSAGE :EXPECTED-TYPE                     (CL:ECASE NUM                         (4 'LIST)                         (10 'CL:NUMBER)                         (14 'CL:SYMBOL)                         (28 'ARRAYP)                         (38 'READTABLEP)                         (39 'TERMTABLEP)                         (51 'CL:HASH-TABLE))])           (5                                                (* ; "HARD DISK ERROR")
              (MAKE-CONDITION 'XCL:SIMPLE-DEVICE-ERROR :MESSAGE MESSAGE))           ((6 35)                                           (* ; 
                                                     "ATTEMPT TO SET NIL, ATTEMPT TO BIND NIL OR T")
              (MAKE-CONDITION 'XCL:ATTEMPT-TO-CHANGE-CONSTANT :NAME NIL))           (7                                                (* ; "ATTEMPT TO RPLAC NIL")
              (MAKE-CONDITION 'XCL:ATTEMPT-TO-RPLAC-NIL :NAME MESSAGE))           (8                                                (* ; "UNDEFINED OR ILLEGAL GO")
              (MAKE-CONDITION 'ILLEGAL-GO :TAG MESSAGE))           (9                                                (* ; "FILE WON'T OPEN")
              (MAKE-CONDITION 'XCL:FILE-WONT-OPEN :PATHNAME MESSAGE))           (11                                               (* ; "ATOM TOO LONG")
              (MAKE-CONDITION 'XCL:SYMBOL-NAME-TOO-LONG))           (12                                               (* ; "ATOM HASH TABLE FULL")
              (MAKE-CONDITION 'XCL:SYMBOL-HT-FULL))           (13                                               (* ; "FILE NOT OPEN")
              (MAKE-CONDITION 'XCL:STREAM-NOT-OPEN :STREAM MESSAGE))           (16                                               (* ; "END OF FILE")
              (MAKE-CONDITION 'END-OF-FILE :STREAM MESSAGE))           (17                                               (* ; "ERROR")
              (MAKE-CONDITION 'INTERLISP-ERROR :MESSAGE MESSAGE))           (19                                               (* ; "ILLEGAL STACK ARG")
              (MAKE-CONDITION 'ILLEGAL-STACK-ARG :ARG MESSAGE))           (21                                               (* ; "ARRAYS FULL")
              (MAKE-CONDITION 'XCL:ARRAY-SPACE-FULL))           (22                                               (* ; "FILE SYSTEM RESOURCES EXCEEDED")
              (MAKE-CONDITION 'XCL:FS-RESOURCES-EXCEEDED :PATHNAME MESSAGE))           (23                                               (* ; "FILE NOT FOUND")
              (MAKE-CONDITION 'XCL:FILE-NOT-FOUND :PATHNAME MESSAGE))           ((25 27)                                          (* ; 
                                                           "UNUSUAL CDR ARG LIST, ILLEGAL ARG")
              (MAKE-CONDITION 'INVALID-ARGUMENT-LIST :ARGUMENT MESSAGE))           (26                                               (* ; "HASH TABLE FULL")
              (MAKE-CONDITION 'XCL:HASH-TABLE-FULL :TABLE MESSAGE))           (30                                               (* ; "STACK PTR HAS BEEN RELEASED")
              (MAKE-CONDITION 'STACK-POINTER-RELEASED :NAME MESSAGE))           (31                                               (* ; "STORAGE FULL")
              (MAKE-CONDITION 'XCL:STORAGE-EXHAUSTED))           (34                                               (* ; "DATA TYPES FULL")
              (MAKE-CONDITION 'XCL:DATA-TYPES-EXHAUSTED))           (41                                               (* ; "PROTECTION VIOLATION")
              (MAKE-CONDITION 'XCL:FS-PROTECTION-VIOLATION :PATHNAME MESSAGE))           (42                                               (* ; "BAD FILE NAME")
              (MAKE-CONDITION 'XCL:INVALID-PATHNAME :PATHNAME MESSAGE))           (44                                               (* ; "UNBOUND ATOM")
              (MAKE-CONDITION 'UNBOUND-VARIABLE :NAME MESSAGE))           (45                                               (* ; "UNDEFINED CAR OF FORM")
              (MAKE-CONDITION 'UNDEFINED-CAR-OF-FORM :FUNCTION MESSAGE))           (46                                               (* ; "UNDEFINED FUNCTION")
              (MAKE-CONDITION 'UNDEFINED-FUNCTION-IN-APPLY :NAME (CL:FIRST MESSAGE)                     :ARGUMENTS                     (CL:SECOND MESSAGE)))           (47                                               (* ; "CONTROL-E")
              (MAKE-CONDITION 'XCL:CONTROL-E-INTERRUPT))           (48                                               (* ; "FLOATING UNDERFLOW")
              (MAKE-CONDITION 'CONDITIONS:FLOATING-POINT-UNDERFLOW))           (49                                               (* ; "FLOATING OVERFLOW")
              (MAKE-CONDITION 'CONDITIONS:FLOATING-POINT-OVERFLOW))           (52                                               (* ; "TOO MANY ARGUMENTS")
              (MAKE-CONDITION 'TOO-MANY-ARGUMENTS :CALLEE MESSAGE :MAXIMUM CL:CALL-ARGUMENTS-LIMIT))           (CL:OTHERWISE (CL:ERROR "Interlisp error number ~D (message: ~S) no longer supported" NUM                                MESSAGE)))))(PUTPROPS AERROR
 FILETYPE
 CL:COMPILE-FILE)(DECLARE%: DOEVAL@COMPILE DONTCOPY(LOCALVARS . T))(PUTPROPS AERROR COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1986 1987 1988 1989 1990))(DECLARE%: DONTCOPY  (FILEMAP (NIL (872 2358 (ERRORSTRING 882 . 995) (SETERRORN 997 . 1114) (LISPERROR 1116 . 1703) (\LISPERROR 1705 . 2174) (\ILLEGAL.ARG 2176 . 2261) (\ARG.NOT.LITATOM 2263 . 2356)))))STOP