(FILECREATED " 1-NOV-83 21:31:49" {PHYLUM}<LISPCORE>SOURCES>AERROR.;8
 4661   

      changes to:  (FNS \LISPERROR)

      previous date: "20-SEP-83 23:20:30" {PHYLUM}<LISPCORE>SOURCES>AERROR.;7)


(* Copyright (c) 1982, 1983 by Xerox Corporation)

(PRETTYCOMPRINT AERRORCOMS)

(RPAQQ AERRORCOMS
 ((FNS ERRORM ERRORN ERRORSTRING SETERRORN LISPERROR \LISPERROR \ILLEGAL.ARG 
			\ARG.NOT.LITATOM)
		   (EXPORT (DECLARE: EVAL@COMPILE (VARS \ERRORMESSAGELIST)
				     DONTCOPY
				     (MACROS LISPERROR)))
		   (VARS (\ERRORNUMBER 1)
			 (\ERRORMESSAGE))
		   (GLOBALVARS \ERRORMESSAGELIST \ERRORMESSAGE \ERRORNUMBER)
		   (LOCALVARS . T)))
(DEFINEQ

(ERRORM

  [LAMBDA (X)                      (* lmm "21-APR-80 15:44")

    [COND
      ((NOT (LISTP X))
	(SETQ X (LIST 17 X]
    (PROG NIL
          (TERPRI T)
          (PRIN1 (OR [CAR (NTH \ERRORMESSAGELIST (ADD1 (OR (NUMBERP (CAR X))
							   17]
		     (QUOTE "ERROR"))
		 T T)
          (TERPRI T)
          (RETURN (PRINT (CAR (OR (LISTP (CDR X))
				  (RETURN)))
			 T T])

(ERRORN

  [LAMBDA NIL                      (* lmm: 26 JUN 75 655)

    (CONS \ERRORNUMBER (COND
	    (\ERRORMESSAGE (LIST (CAR \ERRORMESSAGE])

(ERRORSTRING

  [LAMBDA (X)                      (* lmm "21-APR-80 15:46")

    (CAR (NTH \ERRORMESSAGELIST (ADD1 (OR (NUMBERP X)
					  17])

(SETERRORN

  [LAMBDA (NUM MESS)               (* lmm: 29 JUN 75 1516)

    (SETQ \ERRORNUMBER NUM)
    (SETQ \ERRORMESSAGE (LIST MESS])

(LISPERROR

  [LAMBDA (N X CONTINUEOKFLG)      (* lmm " 6-MAY-80 21:30")

                                   (* compiles open as call to \LISPERROR)

    (\LISPERROR
 X N CONTINUEOKFLG])

(\LISPERROR

  [LAMBDA (X N CONTINUEOKFLG)                                (* bvm: " 1-NOV-83 21:07")

    (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 
(DECLARE: EVAL@COMPILE 

(PUTPROPS LISPERROR MACRO
 [ARGS (CONS (QUOTE \LISPERROR)
				      (CONS (CADR ARGS)
					    (CONS (COND
						    [(STRINGP (CAR ARGS))
						      (for
 X in
 \ERRORMESSAGELIST as
 I from
 0
							 when
 (EQUAL X (CAR ARGS))
							 do
 (RETURN I)
							 finally
 (RETURN (HELP 
									  "Unknown error message"
									       ARGS]
						    (T (CAR ARGS)))
						  (CDDR ARGS])
)
)


(* END EXPORTED DEFINITIONS)


(RPAQQ \ERRORNUMBER
 1)

(RPAQQ \ERRORMESSAGE
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \ERRORMESSAGELIST \ERRORMESSAGE \ERRORNUMBER)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(PUTPROPS AERROR COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (645 2543 (ERRORM 655 . 1039) (ERRORN 1041 . 1188) (ERRORSTRING 1190 . 1335) (SETERRORN 
1337 . 1477) (LISPERROR 1479 . 1675) (\LISPERROR 1677 . 2295) (\ILLEGAL.ARG 2297 . 2414) (
\ARG.NOT.LITATOM 2416 . 2541)))))
STOP