Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/errorm.lap
There are no other files named errorm.lap in the archive.
;;; CLC vP.U.V.1(2) compiling CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7
(IN-PACKAGE (QUOTE LISP))
(EXPORT (QUOTE (CONDITION-BIND CONDITION-CASE CONDITION-PSETQ CHECK-TYPE ASSERT ERRSET)))
(DEFVAR CONDITION-HANDLER-BINDINGS NIL "The binding stack where condition handlers are stored.")
(%PUT (QUOTE CONDITION-BIND) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Eval forms under temporary new condition handlers. See manual for details."))
#_(LAP #0_CONDITION-BIND MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(2 "Macro ~S cannot be called with ~S args." CONDITION-BIND LET CONDITION-HANDLER-BINDINGS LIST* (CONDITION-HANDLER-BINDINGS) (DECLARE (SPECIAL CONDITION-HANDLER-BINDINGS)) CERROR (QUOTE :WRONG-TYPE-ARGUMENT) "bad condition spec ~s. should be symbol or list of ~
symbols." CONS QUOTE)
(CODE-START)
(LABEL 1) (ADDI Q 11)
(MOVEM O1 -10 Q)
(CALL LENGTH 1)
(MOVEM O1 -9 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -10 Q)
(CALL LENGTH 1)
(CALL 1- 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 1))
(MOVE O2 (CONSTANT 2))
(CALL ERROR 3)
(JRST 3)
(LABEL 4) (SKIPA)
(JRST 5)
(MOVE O1 -10 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O1 -10 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -7 Q)
(MOVE O5 -8 Q)
(MOVEM O5 -6 Q)
(MOVEM NIL -5 Q)
(MOVEM NIL -4 Q)
(LABEL 10) (SKIPE NIL -6 Q)
(JRST 11)
(MOVE O1 -5 Q)
(CALL NREVERSE 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 6))
(CALL APPEND 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 5))
(CALL CONS 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 4))
(CALL LIST 2)
(CALL LIST 1)
(MOVEM O1 -2 Q)
(MOVE O4 -7 Q)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -2 Q)
(MOVE O3 (CONSTANT 7))
(CALL LIST* 4)
(JRST 6)
(LABEL 11) (MOVE O1 -6 Q)
(MOVE O1 0 O1)
(MOVE O1 0 O1)
(MOVEM O1 -4 Q)
(CALL SYMBOLP 1)
(JUMPN O1 15)
(MOVE O1 -4 Q)
(CALL ATOM 1)
(JUMPN1 O1 16)
(MOVE O5 -4 Q)
(MOVEM O5 -2 Q)
(LABEL 22) (SKIPE NIL -2 Q)
(JRST 23)
(JRST 18)
(JRST1 18)
(LABEL 23) (MOVE O1 -2 Q)
(MOVE O1 0 O1)
(CALL SYMBOLP 1)
(JUMPN O1 25)
(JRST1 18)
(LABEL 25) (MOVE O1 -2 Q)
(MOVE O1 1 O1)
(MOVEM O1 -2 Q)
(JRST 22)
(LABEL 18)
(LABEL 16)
(LABEL 15) (JRST 13)
(MOVE O4 -4 Q)
(MOVE O1 (CONSTANT 8))
(MOVE O2 (CONSTANT 9))
(MOVE O3 (CONSTANT 10))
(CALL LIST 4)
(JRST 6)
(LABEL 13) (MOVE O1 -4 Q)
(CALL ATOM 1)
(JUMPN O1 27)
(MOVE O5 -4 Q)
(MOVEM O5 -2 Q)
(LABEL 33) (SKIPE NIL -2 Q)
(JRST 34)
(JRST 29)
(LABEL 34) (MOVE O1 -2 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 12))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O1 -6 Q)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O3 0 O1)
(MOVE O1 (CONSTANT 11))
(MOVE O2 0 Q)
(CALL LIST 3)
(MOVEM O1 -1 Q)
(MOVE O2 -5 Q)
(CALL CONS 2)
(MOVEM O1 -5 Q)
(MOVE O1 -2 Q)
(MOVE O1 1 O1)
(MOVEM O1 -2 Q)
(JRST 33)
(LABEL 29) (JRST 28)
(LABEL 27) (MOVE O2 -4 Q)
(MOVE O1 (CONSTANT 12))
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O1 -6 Q)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O3 0 O1)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -2 Q)
(CALL LIST 3)
(MOVEM O1 -3 Q)
(MOVE O2 -5 Q)
(CALL CONS 2)
(MOVEM O1 -5 Q)
(LABEL 28) (MOVE O1 -6 Q)
(MOVE O1 1 O1)
(MOVEM O1 -6 Q)
(JRST 10)
(LABEL 6)
(LABEL 5)
(LABEL 3) (SUBI Q 11)
(POPJ P)
)
(%PUT (QUOTE CONDITION-BIND) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (BINDINGS &REST FORMS)))
(%PUT (QUOTE CONDITION-BIND) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7") (GET (QUOTE CONDITION-BIND) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CONDITION-PSETQ) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Establish new condition handlers for duration of active condition-bind."))
#_(LAP #0_CONDITION-PSETQ MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(1 (CERROR (QUOTE :CONTRADICTORY-ARGUMENTS) "conditions and handlers must come in pairs.") CDAR SETQ CONDITION-HANDLER-BINDINGS LIST* (CONDITION-HANDLER-BINDINGS) (CERROR (QUOTE :WRONG-TYPE-ARGUMENT) "bad condition spec ~s. should be symbol or list of ~
symbols." COND-SPEC) CONS QUOTE)
(CODE-START)
(LABEL 1) (ADDI Q 10)
(MOVEM O1 -9 Q)
(MOVE O5 1 O1)
(MOVEM O5 -8 Q)
(MOVE O1 O5)
(CALL LENGTH 1)
(MOVEM O1 -7 Q)
(MOVE O3 (CONSTANT 0))
(MOVE O1 (CONSTANT 0))
(MOVE O2 -7 Q)
(CALL BOOLE 3)
(CALL ZEROP 1)
(JUMPN O1 3)
(MOVE O1 (CONSTANT 1))
(MOVEI N 1)
(JRST 4)
(LABEL 3) (MOVE O5 -8 Q)
(MOVEM O5 -7 Q)
(MOVEM NIL -6 Q)
(MOVEM NIL -5 Q)
(LABEL 9) (MOVE O1 -7 Q)
(CALL ATOM 1)
(JUMPE O1 10)
(MOVE O1 -6 Q)
(CALL NREVERSE 1)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 6))
(CALL APPEND 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 5))
(CALL CONS 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 (CONSTANT 4))
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 2))
(CALL LIST 2)
(JRST 5)
(LABEL 10) (MOVE O1 -7 Q)
(MOVE O1 0 O1)
(MOVEM O1 -5 Q)
(CALL SYMBOLP 1)
(JUMPN O1 14)
(MOVE O1 -5 Q)
(CALL ATOM 1)
(JUMPN1 O1 15)
(MOVE O5 -5 Q)
(MOVEM O5 -3 Q)
(LABEL 21) (SKIPE NIL -3 Q)
(JRST 22)
(JRST 17)
(JRST1 17)
(LABEL 22) (MOVE O1 -3 Q)
(MOVE O1 0 O1)
(CALL SYMBOLP 1)
(JUMPN O1 24)
(JRST1 17)
(LABEL 24) (MOVE O1 -3 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(JRST 21)
(LABEL 17)
(LABEL 15)
(LABEL 14) (JRST 12)
(MOVE O1 (CONSTANT 7))
(MOVEI N 1)
(JRST 5)
(LABEL 12) (MOVE O1 -5 Q)
(CALL ATOM 1)
(JUMPN O1 26)
(MOVE O5 -5 Q)
(MOVEM O5 -3 Q)
(LABEL 32) (SKIPE NIL -3 Q)
(JRST 33)
(JRST 28)
(LABEL 33) (MOVE O1 -3 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 9))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O1 -7 Q)
(MOVE O1 1 O1)
(MOVE O3 0 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -1 Q)
(CALL LIST 3)
(MOVEM O1 -2 Q)
(MOVE O2 -6 Q)
(CALL CONS 2)
(MOVEM O1 -6 Q)
(MOVE O1 -3 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(JRST 32)
(LABEL 28) (JRST 27)
(LABEL 26) (MOVE O2 -5 Q)
(MOVE O1 (CONSTANT 9))
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O1 -7 Q)
(MOVE O1 1 O1)
(MOVE O3 0 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -3 Q)
(CALL LIST 3)
(MOVEM O1 -4 Q)
(MOVE O2 -6 Q)
(CALL CONS 2)
(MOVEM O1 -6 Q)
(LABEL 27) (MOVE O1 -7 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVEM O1 -7 Q)
(JRST 9)
(LABEL 5)
(LABEL 4) (SUBI Q 10)
(POPJ P)
)
(%PUT (QUOTE CONDITION-PSETQ) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST SPECS)))
(%PUT (QUOTE CONDITION-PSETQ) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7") (GET (QUOTE CONDITION-PSETQ) (QUOTE %SOURCE-DOCUMENTATION))))
#_(LAP #0_CONDITION-CASE MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(2 "Macro ~S cannot be called with ~S args." CONDITION-CASE LET* CONDITION-HANDLER-BINDINGS NCONC QUOTE (CONDITION-HANDLER-BINDINGS) (HANDLER-FINGER-PRINT NIL) RESULTS MULTIPLE-VALUE-LIST CATCH (QUOTE CONDITION-CASE) (DECLARE (SPECIAL CONDITION-HANDLER-BINDINGS)) IF HANDLER-FINGER-PRINT CASE ((VALUES-LIST RESULTS)))
(CODE-START)
(LABEL 1) (ADDI Q 10)
(MOVEM O1 -9 Q)
(CALL LENGTH 1)
(MOVEM O1 -8 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -9 Q)
(CALL LENGTH 1)
(CALL 1- 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 1))
(MOVE O2 (CONSTANT 2))
(CALL ERROR 3)
(JRST 3)
(LABEL 4) (SKIPA)
(JRST 5)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -7 Q)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -6 Q)
(MOVEM O5 -5 Q)
(MOVEM NIL -4 Q)
(LABEL 10) (SKIPE NIL -5 Q)
(JRST 11)
(MOVE O2 -4 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 7))
(MOVE O1 (CONSTANT 5))
(MOVE O2 -1 Q)
(CALL LIST* 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 4))
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O3 -7 Q)
(MOVE O1 (CONSTANT 11))
(MOVE O2 (CONSTANT 12))
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 10))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 9))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 -2 Q)
(MOVE O2 (CONSTANT 8))
(CALL LIST 3)
(MOVEM O1 -2 Q)
(MOVE O3 -6 Q)
(MOVE O1 (CONSTANT 16))
(MOVE O2 (CONSTANT 15))
(CALL LIST* 3)
(MOVEM O1 0 Q)
(MOVE O4 (CONSTANT 17))
(MOVE O1 (CONSTANT 14))
(MOVE O2 (CONSTANT 15))
(MOVE O3 0 Q)
(CALL LIST* 4)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -2 Q)
(MOVE O3 (CONSTANT 13))
(CALL LIST 4)
(JRST 6)
(LABEL 11) (MOVE O1 -5 Q)
(MOVE O5 1 O1)
(MOVEM O5 -3 Q)
(MOVE O1 0 O1)
(MOVE O1 0 O1)
(CALL LISP::MAKE-HANDLER-BINDINGS 1)
(MOVE O2 O1)
(MOVE O1 -4 Q)
(CALL APPEND 2)
(MOVEM O1 -2 Q)
(MOVE O1 -3 Q)
(MOVEM O1 -5 Q)
(MOVE O1 -2 Q)
(MOVEM O1 -4 Q)
(JRST 10)
(LABEL 6)
(LABEL 5)
(LABEL 3) (SUBI Q 10)
(POPJ P)
)
(%PUT (QUOTE CONDITION-CASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (FORM &REST CLAUSES)))
(%PUT (QUOTE CONDITION-CASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7") (GET (QUOTE CONDITION-CASE) (QUOTE %SOURCE-DOCUMENTATION))))
#_(LAP #0_MAKE-HANDLER-BINDINGS EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(CONDITION-CASE-HANDLER)
(CODE-START)
(LABEL 1) (ADDI Q 5)
(MOVEM O1 -4 Q)
(CALL LISTP 1)
(JUMPE O1 4)
(MOVE O5 -4 Q)
(MOVEM O5 -3 Q)
(JRST 5)
(LABEL 4) (MOVE O1 -4 Q)
(CALL LIST 1)
(MOVEM O1 -3 Q)
(LABEL 5) (MOVEM NIL -2 Q)
(LABEL 9) (SKIPE NIL -3 Q)
(JRST 10)
(MOVE O1 -2 Q)
(MOVEI N 1)
(JRST 3)
(LABEL 10) (MOVE O1 -3 Q)
(MOVE O5 1 O1)
(MOVEM O5 -1 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 0))
(MOVE O1 O5)
(CALL CONS 2)
(MOVEM O1 0 Q)
(MOVE O2 -2 Q)
(CALL CONS 2)
(MOVEM O1 0 Q)
(MOVE O1 -1 Q)
(MOVEM O1 -3 Q)
(MOVE O1 0 Q)
(MOVEM O1 -2 Q)
(JRST 9)
(LABEL 3) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE MAKE-HANDLER-BINDINGS) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (KEY-FORM)))
(%PUT (QUOTE MAKE-HANDLER-BINDINGS) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7") (GET (QUOTE MAKE-HANDLER-BINDINGS) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE HANDLER-FINGER-PRINT) (QUOTE GLOBALLY-SPECIAL) T)
#_(LAP #0_CONDITION-CASE-HANDLER EXPR
(ENTRY-POINTS (2-FEW 2 3 4 5 6 7) REST)
#0_(HANDLER-FINGER-PRINT CONDITION-CASE)
(CODE-START)
(LABEL 2) (MOVE O2 NIL)
(JRST 1)
(LABEL 3) (MOVEI W2 1)
(ICALL REST2)
(JRST 1)
(LABEL 4) (MOVEI W2 2)
(ICALL REST3)
(JRST 1)
(LABEL 5) (MOVEI W2 3)
(ICALL REST4)
(JRST 1)
(LABEL 6) (MOVEI W2 4)
(ICALL REST5)
(JRST 1)
(LABEL 7) (MOVEI W2 1)
(ICALL RESTX)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(MOVEM O1 (SPECIAL 0))
(MOVE O1 (CONSTANT 1))
(ICALL CTHROW)
(MOVE O1 NIL)
(MOVEI N 1)
(POPJ P)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE CONDITION-CASE-HANDLER) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (CONDITION &REST IGNORE)))
(%PUT (QUOTE CONDITION-CASE-HANDLER) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7") (GET (QUOTE CONDITION-CASE-HANDLER) (QUOTE %SOURCE-DOCUMENTATION))))
(DEFVAR *ASSERTION-REFERENCES* NIL "A list of the REFERENCE args to the current failed assertion.")
(DEFVAR *ASSERTION-TEST* NIL "The test form in the current failed assertion.")
(%PUT (QUOTE ASSERT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Signals an error if the value of TEST-FORM is NIL. Continuing from this
error will allow the user to alter the values of some variables, and ASSERT
will then start over, evaluating TEST-FORM again. Returns NIL."))
#_(LAP #0_ASSERT MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(2 "Macro ~S cannot be called with ~S args." ASSERT PROG *ASSERTION-REFERENCES* QUOTE *ASSERTION-TEST* TOP IF ((RETURN NIL)) CERROR "Test the assertion again." "Failed assertion." ((GO TOP)))
(CODE-START)
(LABEL 1) (ADDI Q 16)
(MOVEM O1 -15 Q)
(CALL LENGTH 1)
(MOVEM O1 -14 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -15 Q)
(CALL LENGTH 1)
(CALL 1- 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 1))
(MOVE O2 (CONSTANT 2))
(CALL ERROR 3)
(JRST 3)
(LABEL 4) (SKIPA)
(JRST 5)
(MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -13 Q)
(MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -12 Q)
(MOVEM O5 -11 Q)
(MOVEM NIL -10 Q)
(LABEL 10) (SKIPN NIL -11 Q)
(JRST1 13)
(MOVE O1 -11 Q)
(MOVE O1 0 O1)
(CALL STRINGP 1)
(SKIPN NIL O1)
(LABEL 13) (JRST 11)
(MOVE O1 -11 Q)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O5 1 O1)
(MOVEM O5 -7 Q)
(MOVE O1 -10 Q)
(CALL REVERSE 1)
(MOVEM O1 -6 Q)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 -5 Q)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 4))
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -13 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 -4 Q)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O5 (CONSTANT 7))
(MOVEM O5 -3 Q)
(MOVE O3 (CONSTANT 9))
(MOVE O1 (CONSTANT 8))
(MOVE O2 -13 Q)
(CALL LIST* 3)
(MOVEM O1 -2 Q)
(SKIPN NIL -8 Q)
(JRST 14)
(MOVE O5 -8 Q)
(MOVEM O5 0 Q)
(JRST 15)
(LABEL 14) (MOVE O5 (CONSTANT 12))
(MOVEM O5 0 Q)
(LABEL 15) (MOVE O4 -7 Q)
(MOVE O1 (CONSTANT 10))
(MOVE O2 (CONSTANT 11))
(MOVE O3 0 Q)
(CALL LIST* 4)
(MOVEM O1 -1 Q)
(PUSH Q (CONSTANT 13))
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVE O5 -2 Q)
(CALL LIST* 6)
(JRST 6)
(LABEL 11) (MOVE O1 -11 Q)
(MOVE O5 1 O1)
(MOVEM O5 -9 Q)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O2 -10 Q)
(MOVE O1 O5)
(CALL CONS 2)
(MOVEM O1 -8 Q)
(MOVE O1 -9 Q)
(MOVEM O1 -11 Q)
(MOVE O1 -8 Q)
(MOVEM O1 -10 Q)
(JRST 10)
(LABEL 6)
(LABEL 5)
(LABEL 3) (SUBI Q 16)
(POPJ P)
)
(%PUT (QUOTE ASSERT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (TEST &REST ARGS)))
(%PUT (QUOTE ASSERT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7") (GET (QUOTE ASSERT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CHECK-TYPE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Signals an error if the contents of PLACE are not of the desired type. If
the user continues from this error, he will be asked for a new value;
CHECK-TYPE will store the new value in PLACE and start over. See manual for
details."))
#_(LAP #0_CHECK-TYPE MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(4 3 "Macro ~S cannot be called with ~S args." CHECK-TYPE PROG TOP IF TYPEP QUOTE ((RETURN T)) CERROR "Prompt for a value to use." "~s should hold an object of type ~a." FORMAT *QUERY-IO* "~%Give a value of type ~a for ~s: " SETF ((EVAL (READ *QUERY-IO*))) ((GO TOP)))
(CODE-START)
(LABEL 1) (ADDI Q 12)
(MOVEM O1 -11 Q)
(CALL LENGTH 1)
(MOVEM O1 -10 Q)
(MOVE O2 (CONSTANT 0))
(CALL > 2)
(JUMPN1 O1 5)
(MOVE O1 -11 Q)
(CALL LENGTH 1)
(MOVEM O1 -10 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O1 -11 Q)
(CALL LENGTH 1)
(CALL 1- 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 2))
(MOVE O2 (CONSTANT 3))
(CALL ERROR 3)
(JRST 3)
(LABEL 4) (SKIPA)
(JRST 6)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -9 Q)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 8)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -7 Q)
(JRST 7)
(LABEL 8) (SKIPA)
(JRST 9)
(MOVEM NIL -7 Q)
(LABEL 9)
(LABEL 7) (MOVE O5 (CONSTANT 4))
(MOVEM O5 -6 Q)
(MOVEM NIL -5 Q)
(MOVE O5 (CONSTANT 5))
(MOVEM O5 -4 Q)
(MOVE O2 -8 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 7))
(MOVE O2 -9 Q)
(CALL LIST 3)
(MOVEM O1 -2 Q)
(MOVE O3 (CONSTANT 9))
(MOVE O1 (CONSTANT 6))
(MOVE O2 -2 Q)
(CALL LIST* 3)
(MOVEM O1 -3 Q)
(MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(SKIPN NIL -7 Q)
(JRST 11)
(MOVE O5 -7 Q)
(JRST 12)
(LABEL 11) (MOVE O2 -8 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVE O5 O1)
(LABEL 12) (MOVE O1 (CONSTANT 10))
(MOVE O2 (CONSTANT 11))
(MOVE O3 (CONSTANT 12))
(MOVE O4 -1 Q)
(CALL LIST 5)
(MOVEM O1 -2 Q)
(SKIPN NIL -7 Q)
(JRST 13)
(MOVE O5 -7 Q)
(MOVEM O5 0 Q)
(JRST 14)
(LABEL 13) (MOVE O2 -8 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVEM O1 0 Q)
(LABEL 14) (MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVE O5 O1)
(MOVE O1 (CONSTANT 13))
(MOVE O2 (CONSTANT 14))
(MOVE O3 (CONSTANT 15))
(MOVE O4 0 Q)
(CALL LIST 5)
(PUSH Q O1)
(MOVE O3 (CONSTANT 17))
(MOVE O1 (CONSTANT 16))
(MOVE O2 -10 Q)
(CALL LIST* 3)
(PUSH Q O1)
(PUSH Q (CONSTANT 18))
(MOVE O1 -9 Q)
(MOVE O2 -8 Q)
(MOVE O3 -7 Q)
(MOVE O4 -6 Q)
(MOVE O5 -5 Q)
(CALL LIST* 8)
(LABEL 6)
(LABEL 3) (SUBI Q 12)
(POPJ P)
)
(%PUT (QUOTE CHECK-TYPE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (PLACE TYPESPEC &OPTIONAL STRING)))
(%PUT (QUOTE CHECK-TYPE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7") (GET (QUOTE CHECK-TYPE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ERRSET) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Maclisp errset. Normally, the values from form are returned. If
an error occurs, then the error message is printed out (if flag is
non-nil) and nil is returned."))
#_(LAP #0_ERRSET MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(3 "Macro ~S cannot be called with ~S args." ERRSET CATCH (QUOTE CATCH-ERROR) CONDITION-BIND :ERROR IF ((FUNCTION (LAMBDA (IGNORE CONTINUE-STRING FUNCTION-NAME ERROR-STRING &REST ARGS) (DECLARE (IGNORE IGNORE)) (ERROR-PRINT ERROR-STRING ARGS FUNCTION-NAME CONTINUE-STRING) (THROW (QUOTE CATCH-ERROR) NIL))) (FUNCTION (LAMBDA (&REST IGNORE) (DECLARE (IGNORE IGNORE)) (THROW (QUOTE CATCH-ERROR) NIL)))))
(CODE-START)
(LABEL 1) (ADDI Q 5)
(MOVEM O1 -4 Q)
(CALL LENGTH 1)
(MOVEM O1 -3 Q)
(MOVE O2 (CONSTANT 0))
(CALL = 2)
(JUMPN O1 4)
(MOVE O1 -4 Q)
(CALL LENGTH 1)
(CALL 1- 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 1))
(MOVE O2 (CONSTANT 2))
(CALL ERROR 3)
(JRST 3)
(LABEL 4) (SKIPA)
(JRST 5)
(MOVE O1 -4 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -2 Q)
(MOVE O1 -4 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O3 (CONSTANT 8))
(MOVE O1 (CONSTANT 7))
(MOVE O2 O5)
(CALL LIST* 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(CALL LIST 1)
(MOVEM O1 0 Q)
(MOVE O3 -2 Q)
(MOVE O1 (CONSTANT 5))
(MOVE O2 0 Q)
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 (CONSTANT 4))
(CALL LIST 3)
(LABEL 5)
(LABEL 3) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE ERRSET) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (FORM FLAG)))
(%PUT (QUOTE ERRSET) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>ERRORM.CLISP.7") (GET (QUOTE ERRSET) (QUOTE %SOURCE-DOCUMENTATION))))