(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "13-Mar-92 14:41:54" {DSK}local>lde>lispcore>sources>AERROR.;2 7354 changes to%: (VARS AERRORCOMS) previous date%: "16-May-90 11:58:35" {DSK}local>lde>lispcore>sources>AERROR.;1) (* ; " Copyright (c) 1982, 1983, 1986, 1987, 1988, 1989, 1990, 1992 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) (BQUOTE (\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 (QUOTE CONDITION)) NUM (CASE NUM (2 (* ; "STACK OVERFLOW") (MAKE-CONDITION (QUOTE STACK-OVERFLOW))) (3 (* ; "ILLEGAL RETURN") (MAKE-CONDITION (QUOTE ILLEGAL-RETURN) :TAG MESSAGE)) ((4 10 14 28 38 39 51) (* ; "ARG NOT x") (MAKE-CONDITION (QUOTE XCL:TYPE-MISMATCH) :NAME MESSAGE :VALUE MESSAGE :EXPECTED-TYPE (CL:ECASE NUM (4 (QUOTE LIST)) (10 (QUOTE CL:NUMBER)) (14 (QUOTE CL:SYMBOL)) (28 (QUOTE ARRAYP)) (38 (QUOTE READTABLEP)) (39 (QUOTE TERMTABLEP)) (51 (QUOTE CL:HASH-TABLE))))) (5 (* ; "HARD DISK ERROR") (MAKE-CONDITION (QUOTE XCL:SIMPLE-DEVICE-ERROR) :MESSAGE MESSAGE)) ((6 35) (* ; "ATTEMPT TO SET NIL, ATTEMPT TO BIND NIL OR T") (MAKE-CONDITION (QUOTE XCL:ATTEMPT-TO-CHANGE-CONSTANT) :NAME NIL)) (7 (* ; "ATTEMPT TO RPLAC NIL") (MAKE-CONDITION (QUOTE XCL:ATTEMPT-TO-RPLAC-NIL) :NAME MESSAGE)) (8 (* ; "UNDEFINED OR ILLEGAL GO") (MAKE-CONDITION (QUOTE ILLEGAL-GO) :TAG MESSAGE)) (9 (* ; "FILE WON'T OPEN") (MAKE-CONDITION (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME MESSAGE)) (11 (* ; "ATOM TOO LONG") (MAKE-CONDITION (QUOTE XCL:SYMBOL-NAME-TOO-LONG))) (12 (* ; "ATOM HASH TABLE FULL") (MAKE-CONDITION (QUOTE XCL:SYMBOL-HT-FULL))) (13 (* ; "FILE NOT OPEN") (MAKE-CONDITION (QUOTE XCL:STREAM-NOT-OPEN) :STREAM MESSAGE)) (16 (* ; "END OF FILE") (MAKE-CONDITION (QUOTE END-OF-FILE) :STREAM MESSAGE)) (17 (* ; "ERROR") (MAKE-CONDITION (QUOTE INTERLISP-ERROR) :MESSAGE MESSAGE)) (19 (* ; "ILLEGAL STACK ARG") (MAKE-CONDITION (QUOTE ILLEGAL-STACK-ARG) :ARG MESSAGE)) (21 (* ; "ARRAYS FULL") (MAKE-CONDITION (QUOTE XCL:ARRAY-SPACE-FULL))) (22 (* ; "FILE SYSTEM RESOURCES EXCEEDED") (MAKE-CONDITION (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME MESSAGE)) (23 (* ; "FILE NOT FOUND") (MAKE-CONDITION (QUOTE XCL:FILE-NOT-FOUND) :PATHNAME MESSAGE)) ((25 27) (* ; "UNUSUAL CDR ARG LIST, ILLEGAL ARG") (MAKE-CONDITION (QUOTE INVALID-ARGUMENT-LIST) :ARGUMENT MESSAGE)) (26 (* ; "HASH TABLE FULL") (MAKE-CONDITION (QUOTE XCL:HASH-TABLE-FULL) :TABLE MESSAGE)) (30 (* ; "STACK PTR HAS BEEN RELEASED") (MAKE-CONDITION (QUOTE STACK-POINTER-RELEASED) :NAME MESSAGE)) (31 (* ; "STORAGE FULL") (MAKE-CONDITION (QUOTE XCL:STORAGE-EXHAUSTED))) (34 (* ; "DATA TYPES FULL") (MAKE-CONDITION (QUOTE XCL:DATA-TYPES-EXHAUSTED))) (41 (* ; "PROTECTION VIOLATION") (MAKE-CONDITION (QUOTE XCL:FS-PROTECTION-VIOLATION) :PATHNAME MESSAGE)) (42 (* ; "BAD FILE NAME") (MAKE-CONDITION (QUOTE XCL:INVALID-PATHNAME) :PATHNAME MESSAGE)) (44 (* ; "UNBOUND ATOM") (MAKE-CONDITION (QUOTE UNBOUND-VARIABLE) :NAME MESSAGE)) (45 (* ; "UNDEFINED CAR OF FORM") (MAKE-CONDITION (QUOTE UNDEFINED-CAR-OF-FORM) :FUNCTION MESSAGE)) (46 (* ; "UNDEFINED FUNCTION") (MAKE-CONDITION (QUOTE UNDEFINED-FUNCTION-IN-APPLY) :NAME (CL:FIRST MESSAGE) :ARGUMENTS (CL:SECOND MESSAGE))) (47 (* ; "CONTROL-E") (MAKE-CONDITION (QUOTE XCL:CONTROL-E-INTERRUPT))) (48 (* ; "FLOATING UNDERFLOW") (MAKE-CONDITION (QUOTE CL:FLOATING-POINT-UNDERFLOW))) (49 (* ; "FLOATING OVERFLOW") (MAKE-CONDITION (QUOTE CL:FLOATING-POINT-OVERFLOW))) (52 (* ; "TOO MANY ARGUMENTS") (MAKE-CONDITION (QUOTE 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 1992)) (DECLARE%: DONTCOPY (FILEMAP (NIL (773 2259 (ERRORSTRING 783 . 896) (SETERRORN 898 . 1015) (LISPERROR 1017 . 1604) ( \LISPERROR 1606 . 2075) (\ILLEGAL.ARG 2077 . 2162) (\ARG.NOT.LITATOM 2164 . 2257))))) STOP