Trailing-Edge
-
PDP-10 Archives
-
clisp
-
clisp/upsala/macros.lap
There are no other files named macros.lap in the archive.
;;; CLC vP.U.V.1(2) compiling CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29
(IN-PACKAGE (QUOTE LISP))
(EXPORT (QUOTE (DEFVAR DEFPARAMETER DEFCONSTANT WHEN UNLESS LOOP SETF DEFSETF PSETF SHIFTF ROTATEF PUSH PUSHNEW POP INCF DECF PUTF REMF CASE TYPECASE WITH-OPEN-FILE WITH-OPEN-STREAM WITH-INPUT-FROM-STRING WITH-OUTPUT-TO-STRING LOCALLY ETYPECASE ECASE DOTIMES DOLIST DO* LDB MASK-FIELD CHAR-BIT CCASE CTYPECASE GET-SETF-METHOD GET-SETF-METHOD-MULTIPLE-VALUE DEFINE-MODIFY-MACRO DEFINE-SETF-METHOD)))
(%PUT (QUOTE DEFVAR) (QUOTE %FUN-DOCUMENTATION) (QUOTE "For defining global variables at top level. Declares the variable
SPECIAL and, optionally, initializes it. If the variable already has a
value, the old value is not clobbered. The third argument is an optional
documentation string for the variable."))
#_(LAP #0_DEFVAR MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(4 2 "Macro ~S cannot be called with ~S args." DEFVAR T PROGN PROCLAIM QUOTE SPECIAL OR BOUNDP SETQ %PUT (QUOTE %VAR-DOCUMENTATION))
(CODE-START)
(LABEL 1) (ADDI Q 11)
(MOVEM O1 -10 Q)
(CALL LENGTH 1)
(MOVEM O1 -9 Q)
(MOVE O2 (CONSTANT 0))
(CALL > 2)
(JUMPN1 O1 5)
(MOVE O1 -10 Q)
(CALL LENGTH 1)
(MOVEM O1 -9 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O1 -10 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 -10 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O1 -10 Q)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 8)
(MOVE O1 -10 Q)
(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 O1 -10 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 4))
(TDCN O1 O1)
(MOVE O1 (CONSTANT 4))
(MOVEM O1 -6 Q)
(MOVE O1 -10 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 12)
(MOVE O1 -10 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(JRST 11)
(LABEL 12) (SKIPA)
(JRST 13)
(MOVEM NIL -5 Q)
(LABEL 13)
(LABEL 11) (MOVE O1 -10 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 4))
(TDCN O1 O1)
(MOVE O1 (CONSTANT 4))
(MOVEM O1 -4 Q)
(MOVE O2 -8 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -3 Q)
(SKIPN NIL -6 Q)
(JRST 16)
(MOVE O2 -8 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 10))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O3 -7 Q)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -8 Q)
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 9))
(MOVE O2 -1 Q)
(CALL LIST 3)
(CALL LIST 1)
(MOVEM O1 -2 Q)
(JRST 15)
(LABEL 16) (SKIPA)
(JRST 17)
(MOVEM NIL -2 Q)
(LABEL 17)
(LABEL 15) (SKIPN NIL -4 Q)
(JRST 20)
(MOVE O2 -8 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -5 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 12))
(MOVE O2 0 Q)
(MOVE O3 (CONSTANT 13))
(CALL LIST 4)
(CALL LIST 1)
(MOVEM O1 -1 Q)
(JRST 19)
(LABEL 20) (SKIPA)
(JRST 21)
(MOVEM NIL -1 Q)
(LABEL 21)
(LABEL 19) (MOVE O2 -8 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O3 O1)
(MOVE O1 -2 Q)
(MOVE O2 -1 Q)
(CALL APPEND 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 5))
(MOVE O2 -3 Q)
(CALL LIST* 3)
(LABEL 6)
(LABEL 3) (SUBI Q 11)
(POPJ P)
)
(%PUT (QUOTE DEFVAR) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (VAR &OPTIONAL (VAL NIL VALP) (DOC NIL DOCP))))
(%PUT (QUOTE DEFVAR) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DEFVAR) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DEFPARAMETER) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Defines a parameter that is not normally changed by the program,
but that may be changed without causing an error. Declares the
variable special and sets its value to VAL. The third argument is
an optional documentation string for the parameter."))
#_(LAP #0_DEFPARAMETER 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." DEFPARAMETER T PROGN PROCLAIM QUOTE SPECIAL SETQ %PUT (QUOTE %VAR-DOCUMENTATION))
(CODE-START)
(LABEL 1) (ADDI Q 10)
(MOVEM O1 -9 Q)
(CALL LENGTH 1)
(MOVEM O1 -8 Q)
(MOVE O2 (CONSTANT 0))
(CALL > 2)
(JUMPN1 O1 5)
(MOVE O1 -9 Q)
(CALL LENGTH 1)
(MOVEM O1 -8 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O1 -9 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 -9 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -7 Q)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 8)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(JRST 7)
(LABEL 8) (SKIPA)
(JRST 9)
(MOVEM NIL -5 Q)
(LABEL 9)
(LABEL 7) (MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 4))
(TDCN O1 O1)
(MOVE O1 (CONSTANT 4))
(MOVEM O1 -4 Q)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O3 -6 Q)
(MOVE O1 (CONSTANT 9))
(MOVE O2 -7 Q)
(CALL LIST 3)
(MOVEM O1 -2 Q)
(SKIPN NIL -4 Q)
(JRST 12)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -5 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 10))
(MOVE O2 0 Q)
(MOVE O3 (CONSTANT 11))
(CALL LIST 4)
(CALL LIST 1)
(MOVEM O1 -1 Q)
(JRST 11)
(LABEL 12) (SKIPA)
(JRST 13)
(MOVEM NIL -1 Q)
(LABEL 13)
(LABEL 11) (MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL APPEND 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 5))
(MOVE O2 -3 Q)
(MOVE O3 -2 Q)
(CALL LIST* 4)
(LABEL 6)
(LABEL 3) (SUBI Q 10)
(POPJ P)
)
(%PUT (QUOTE DEFPARAMETER) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (VAR VAL &OPTIONAL (DOC NIL DOCP))))
(%PUT (QUOTE DEFPARAMETER) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DEFPARAMETER) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DEFCONSTANT) (QUOTE %FUN-DOCUMENTATION) (QUOTE "For defining global constants at top level. Declares the variable
SPECIAL and initializes it. The DEFCONST says that the value is
constant and may be compiled into code. If the variable already has a
value, and this is not equal to the init, an error is signalled.
The third argument is an optional documentation string for the variable."))
#_(LAP #0_DEFCONSTANT 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." DEFCONSTANT T PROGN PROCLAIM QUOTE SPECIAL REMPROP ((QUOTE %CONSTANT)) COND BOUNDP UNLESS EQUALP CERROR "Go ahead and change the value." "Constant ~S being redefined." SETQ %PUT ((QUOTE %CONSTANT) T) (QUOTE %VAR-DOCUMENTATION))
(CODE-START)
(LABEL 1) (ADDI Q 14)
(MOVEM O1 -13 Q)
(CALL LENGTH 1)
(MOVEM O1 -12 Q)
(MOVE O2 (CONSTANT 0))
(CALL > 2)
(JUMPN1 O1 5)
(MOVE O1 -13 Q)
(CALL LENGTH 1)
(MOVEM O1 -12 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O1 -13 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 -13 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -11 Q)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -10 Q)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 8)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -9 Q)
(JRST 7)
(LABEL 8) (SKIPA)
(JRST 9)
(MOVEM NIL -9 Q)
(LABEL 9)
(LABEL 7) (MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(TDCN O1 O1)
(MOVE O1 (CONSTANT 4))
(TDCN O1 O1)
(MOVE O1 (CONSTANT 4))
(MOVEM O1 -8 Q)
(MOVE O5 (CONSTANT 5))
(MOVEM O5 -7 Q)
(MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -6 Q)
(MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O3 (CONSTANT 10))
(MOVE O1 (CONSTANT 9))
(MOVE O2 -4 Q)
(CALL LIST* 3)
(MOVEM O1 -5 Q)
(MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 12))
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O3 -10 Q)
(MOVE O1 (CONSTANT 14))
(MOVE O2 -11 Q)
(CALL LIST 3)
(MOVEM O1 -1 Q)
(MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 15))
(MOVE O2 (CONSTANT 16))
(MOVE O3 (CONSTANT 17))
(CALL LIST 4)
(MOVEM O1 0 Q)
(MOVE O3 -10 Q)
(MOVE O1 (CONSTANT 18))
(MOVE O2 -11 Q)
(CALL LIST 3)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 13))
(MOVE O2 -1 Q)
(MOVE O3 0 Q)
(CALL LIST 4)
(MOVE O2 O1)
(MOVE O1 -3 Q)
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O3 -10 Q)
(MOVE O1 (CONSTANT 18))
(MOVE O2 -11 Q)
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 4))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -3 Q)
(CALL LIST 3)
(MOVEM O1 -4 Q)
(MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O3 (CONSTANT 20))
(MOVE O1 (CONSTANT 19))
(MOVE O2 -2 Q)
(CALL LIST* 3)
(MOVEM O1 -3 Q)
(SKIPN NIL -8 Q)
(JRST 12)
(MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 19))
(MOVE O2 -1 Q)
(MOVE O3 (CONSTANT 21))
(CALL LIST 4)
(CALL LIST 1)
(MOVEM O1 -2 Q)
(JRST 11)
(LABEL 12) (SKIPA)
(JRST 13)
(MOVEM NIL -2 Q)
(LABEL 13)
(LABEL 11) (MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -2 Q)
(CALL APPEND 2)
(PUSH Q O1)
(MOVE O1 -8 Q)
(MOVE O2 -7 Q)
(MOVE O3 -6 Q)
(MOVE O4 -5 Q)
(MOVE O5 -4 Q)
(CALL LIST* 6)
(LABEL 6)
(LABEL 3) (SUBI Q 14)
(POPJ P)
)
(%PUT (QUOTE DEFCONSTANT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (VAR VAL &OPTIONAL (DOC NIL DOCP))))
(%PUT (QUOTE DEFCONSTANT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DEFCONSTANT) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE WHEN) (QUOTE %FUN-DOCUMENTATION) (QUOTE "First arg is a predicate. If it is non-null, the rest of the forms are
evaluated as a PROGN."))
#_(LAP #0_WHEN MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(COND)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(MOVE O5 1 O1)
(MOVEM O5 -1 Q)
(MOVE O1 O5)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O3 1 O1)
(MOVE O1 O5)
(MOVE O2 NIL)
(CALL LIST* 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 0))
(CALL LIST 2)
(SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE WHEN) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST FORMS)))
(%PUT (QUOTE WHEN) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE WHEN) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE UNLESS) (QUOTE %FUN-DOCUMENTATION) (QUOTE "First arg is a predicate. If it is null, the rest of the forms are
evaluated as a PROGN."))
#_(LAP #0_UNLESS 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." UNLESS COND NOT)
(CODE-START)
(LABEL 1) (ADDI Q 5)
(MOVEM O1 -4 Q)
(CALL LENGTH 1)
(MOVEM O1 -3 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE 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 O5 1 O1)
(MOVEM O5 -1 Q)
(MOVE O2 -2 Q)
(MOVE O1 (CONSTANT 4))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O3 -1 Q)
(MOVE O2 NIL)
(CALL LIST* 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 3))
(CALL LIST 2)
(LABEL 5)
(LABEL 3) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE UNLESS) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (TEST &REST FORMS)))
(%PUT (QUOTE UNLESS) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE UNLESS) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DO*) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Iteration construct. Like DO, but does inits and steps in serial,
not all at once."))
#_(LAP #0_DO* 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." DO* "Ill-formed DO -- possibly illegal old style DO?" DECLARE 1 2 "~S is illegal form in a DO varlist." BLOCK LET* TAGBODY AND RETURN PROGN SETQ GO)
(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 O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -12 Q)
(MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -11 Q)
(MOVEM NIL -10 Q)
(MOVEM NIL -9 Q)
(MOVEM NIL -8 Q)
(CALL GENSYM 0)
(MOVEM O1 -7 Q)
(SKIPN NIL -13 Q)
(JRST1 9)
(MOVE O1 -13 Q)
(CALL ATOM 1)
(SKIPE NIL O1)
(LABEL 9) (JRST1 8)
(SKIPN NIL -12 Q)
(JRST 11)
(MOVE O1 -12 Q)
(CALL ATOM 1)
(SKIPN NIL O1)
(LABEL 11)
(LABEL 8) (JRST 6)
(MOVE O2 NIL)
(MOVE O1 (CONSTANT 3))
(CALL ERROR 2)
(LABEL 6) (MOVE O5 -11 Q)
(MOVEM O5 -6 Q)
(LABEL 17) (MOVE O1 -6 Q)
(CALL ATOM 1)
(JUMPN1 O1 20)
(SKIPN NIL -6 Q)
(JRST1 21)
(MOVE O1 -6 Q)
(SKIPN NIL 0 O1)
(JRST1 21)
(MOVE O1 -6 Q)
(MOVE O1 0 O1)
(CALL LISTP 1)
(JUMPE1 O1 21)
(MOVE O1 -6 Q)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(MOVE O2 (CONSTANT 4))
(CAMN O2 -5 Q)
(LABEL 21)
(LABEL 20) (JRST 18)
(MOVE O1 -10 Q)
(CALL NREVERSE 1)
(MOVEM O1 -10 Q)
(MOVE O1 -6 Q)
(MOVEM O1 -11 Q)
(JRST 13)
(LABEL 18) (MOVE O1 -6 Q)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(MOVE O2 -10 Q)
(MOVE O1 O5)
(CALL CONS 2)
(MOVEM O1 -10 Q)
(MOVE O1 -6 Q)
(MOVE O1 1 O1)
(MOVEM O1 -6 Q)
(JRST 17)
(LABEL 13) (MOVE O5 -13 Q)
(MOVEM O5 -6 Q)
(MOVEM NIL -5 Q)
(LABEL 27) (MOVE O1 -6 Q)
(CALL ATOM 1)
(JUMPE O1 28)
(JRST 23)
(LABEL 28) (MOVE O1 -6 Q)
(MOVE O1 0 O1)
(MOVEM O1 -5 Q)
(CALL ATOM 1)
(JUMPE O1 31)
(MOVE O2 -9 Q)
(MOVE O1 -5 Q)
(CALL CONS 2)
(MOVEM O1 -9 Q)
(JRST 30)
(LABEL 31) (MOVE O1 -5 Q)
(CALL LENGTH 1)
(MOVEM O1 -4 Q)
(MOVE O2 (CONSTANT 5))
(CALL = 2)
(JUMPE O1 33)
(MOVE O1 -5 Q)
(MOVE O1 0 O1)
(CALL SYMBOLP 1)
(SKIPN NIL O1)
(LABEL 33) (JRST 32)
(MOVE O1 -5 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O2 -9 Q)
(MOVE O1 O5)
(CALL CONS 2)
(MOVEM O1 -9 Q)
(JRST 30)
(LABEL 32) (MOVE O1 -5 Q)
(CALL LENGTH 1)
(MOVEM O1 -4 Q)
(MOVE O2 (CONSTANT 6))
(CALL = 2)
(JUMPE O1 36)
(MOVE O1 -5 Q)
(MOVE O1 0 O1)
(CALL SYMBOLP 1)
(SKIPN NIL O1)
(LABEL 36) (JRST 35)
(MOVE O2 -9 Q)
(MOVE O1 -5 Q)
(CALL CONS 2)
(MOVEM O1 -9 Q)
(JRST 30)
(LABEL 35) (MOVE O1 -5 Q)
(CALL LENGTH 1)
(MOVEM O1 -4 Q)
(MOVE O2 (CONSTANT 0))
(CALL = 2)
(JUMPE O1 39)
(MOVE O1 -5 Q)
(MOVE O1 0 O1)
(CALL SYMBOLP 1)
(SKIPN NIL O1)
(LABEL 39) (JRST 38)
(MOVE O1 -5 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O1 1 O1)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -9 Q)
(CALL CONS 2)
(MOVEM O1 -9 Q)
(MOVE O1 -5 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O1 -5 Q)
(MOVE O5 0 O1)
(MOVEM O5 -3 Q)
(MOVE O2 -8 Q)
(MOVE O1 O5)
(CALL CONS 2)
(MOVE O2 O1)
(MOVE O1 -4 Q)
(CALL CONS 2)
(MOVEM O1 -8 Q)
(JRST 30)
(LABEL 38) (SKIPA)
(JRST 41)
(MOVE O2 -5 Q)
(MOVE O1 (CONSTANT 7))
(CALL ERROR 2)
(LABEL 41)
(LABEL 30) (MOVE O1 -6 Q)
(MOVE O1 1 O1)
(MOVEM O1 -6 Q)
(JRST 27)
(LABEL 23) (MOVE O1 -9 Q)
(CALL NREVERSE 1)
(MOVEM O1 -4 Q)
(MOVE O1 -12 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O2 1 O1)
(MOVE O1 (CONSTANT 13))
(CALL CONS 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 12))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -1 Q)
(CALL LIST 3)
(MOVEM O1 -2 Q)
(MOVE O1 -8 Q)
(CALL NREVERSE 1)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 14))
(CALL CONS 2)
(MOVEM O1 0 Q)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 15))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 -11 Q)
(CALL APPEND 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 10))
(MOVE O2 -7 Q)
(MOVE O3 -2 Q)
(CALL LIST* 4)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -10 Q)
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 9))
(MOVE O2 -4 Q)
(CALL LIST* 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 NIL)
(CALL LIST 3)
(LABEL 5)
(LABEL 3) (SUBI Q 16)
(POPJ P)
)
(%PUT (QUOTE DO*) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (VARLIST ENDLIST &BODY BODY)))
(%PUT (QUOTE DO*) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DO*) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DOTIMES) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Syntax is (DOTIMES (var count [result]) . body).
Do body COUNT times with VAR increasing from 0 to COUNT - 1.
Return result form or NIL."))
#_(LAP #0_DOTIMES 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." DOTIMES DO 0 1+ >=)
(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 O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -7 Q)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 7)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(JRST 6)
(LABEL 7) (SKIPA)
(JRST 8)
(MOVEM NIL -5 Q)
(LABEL 8)
(LABEL 6) (MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -4 Q)
(MOVE O1 -6 Q)
(CALL NUMBERP 1)
(JUMPE O1 11)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 -7 Q)
(MOVE O2 (CONSTANT 4))
(CALL LIST 3)
(CALL LIST 1)
(MOVEM O1 -3 Q)
(MOVE O3 -6 Q)
(MOVE O1 (CONSTANT 6))
(MOVE O2 -7 Q)
(CALL LIST 3)
(MOVEM O1 -2 Q)
(MOVE O2 -5 Q)
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O4 -4 Q)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -3 Q)
(MOVE O3 -2 Q)
(CALL LIST* 4)
(JRST 10)
(LABEL 11) (SKIPA)
(JRST 12)
(CALL GENSYM 0)
(MOVEM O1 -3 Q)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 -7 Q)
(MOVE O2 (CONSTANT 4))
(CALL LIST 3)
(MOVEM O1 -1 Q)
(MOVE O2 -6 Q)
(MOVE O1 -3 Q)
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O3 -3 Q)
(MOVE O1 (CONSTANT 6))
(MOVE O2 -7 Q)
(CALL LIST 3)
(MOVEM O1 0 Q)
(MOVE O2 -5 Q)
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O4 -4 Q)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -1 Q)
(MOVE O3 0 Q)
(CALL LIST* 4)
(LABEL 12)
(LABEL 10)
(LABEL 5)
(LABEL 3) (SUBI Q 10)
(POPJ P)
)
(%PUT (QUOTE DOTIMES) (QUOTE %ARGS-DOCUMENTATION) (QUOTE ((VAR COUNT &OPTIONAL (RESULT NIL)) &BODY BODY)))
(%PUT (QUOTE DOTIMES) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DOTIMES) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DOLIST) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Syntax is (DOLIST (var list [result]) . body).
Do body with VAR bound to each member of LIST, then return result
form or NIL."))
#_(LAP #0_DOLIST 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." DOLIST DO* CDR CAR ATOM)
(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 O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -7 Q)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 7)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(JRST 6)
(LABEL 7) (SKIPA)
(JRST 8)
(MOVEM NIL -5 Q)
(LABEL 8)
(LABEL 6) (MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -4 Q)
(CALL GENSYM 0)
(MOVEM O1 -3 Q)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 4))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 -3 Q)
(MOVE O2 -6 Q)
(CALL LIST 3)
(MOVEM O1 -2 Q)
(MOVE O2 -3 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 -7 Q)
(MOVE O2 0 Q)
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 -2 Q)
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O2 -3 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O2 -5 Q)
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O4 -4 Q)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -2 Q)
(MOVE O3 -1 Q)
(CALL LIST* 4)
(LABEL 5)
(LABEL 3) (SUBI Q 10)
(POPJ P)
)
(%PUT (QUOTE DOLIST) (QUOTE %ARGS-DOCUMENTATION) (QUOTE ((VAR LIST &OPTIONAL (RESULT NIL)) &BODY BODY)))
(%PUT (QUOTE DOLIST) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DOLIST) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE *IN-THE-COMPILER*) (QUOTE GLOBALLY-SPECIAL) T)
(%PUT (QUOTE GET-SETF-METHOD) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns five values needed by the SETF machinery: a list of temporary
variables, a list of values with which to fill them, the temporary for the
new value in a list, the setting function, and the accessing function."))
#_(LAP #0_GET-SETF-METHOD EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(SETQ "~S illegal atomic form for GET-SETF-METHOD." SETF-INVERSE SETF-METHOD-EXPANDER *IN-THE-COMPILER* "~S is not a known location specifier for SETF.")
(CODE-START)
(LABEL 1) (ADDI Q 11)
(MOVEM O1 -10 Q)
(MOVEM NIL -9 Q)
(CALL SYMBOLP 1)
(JUMPE O1 4)
(CALL GENSYM 0)
(MOVEM O1 -7 Q)
(CALL LIST 1)
(MOVEM O1 -4 Q)
(MOVE O3 -7 Q)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -10 Q)
(CALL LIST 3)
(MOVEM O1 -3 Q)
(MOVE O5 -10 Q)
(MOVE O1 NIL)
(MOVE O2 O1)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVEI N 5)
(JRST 3)
(LABEL 4) (MOVE O1 -10 Q)
(CALL ATOM 1)
(JUMPE O1 5)
(MOVE O2 -10 Q)
(MOVE O1 (CONSTANT 1))
(CALL ERROR 2)
(JRST 3)
(LABEL 5) (MOVE O1 -10 Q)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O2 (CONSTANT 2))
(MOVE O1 O5)
(CALL GET 2)
(MOVEM O1 -9 Q)
(JUMPE O1 6)
(CALL GENSYM 0)
(MOVEM O1 -7 Q)
(MOVEM NIL -6 Q)
(MOVEM NIL -5 Q)
(MOVE O1 -10 Q)
(MOVE O5 1 O1)
(MOVEM O5 -3 Q)
(MOVE O1 O5)
(MOVE O5 0 O1)
(MOVEM O5 -2 Q)
(LABEL 11) (MOVE O1 -3 Q)
(CALL ATOM 1)
(JUMPE O1 12)
(JRST 7)
(LABEL 12) (CALL GENSYM 0)
(MOVEM O1 -1 Q)
(MOVE O2 -6 Q)
(CALL CONS 2)
(MOVEM O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O1 -2 Q)
(CALL CONS 2)
(MOVEM O1 -5 Q)
(MOVE O1 -3 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVE O1 0 O1)
(MOVEM O1 -2 Q)
(JRST 11)
(LABEL 7) (MOVE O1 -5 Q)
(CALL NREVERSE 1)
(MOVEM O1 -5 Q)
(MOVE O1 -7 Q)
(CALL LIST 1)
(MOVEM O1 -2 Q)
(MOVE O1 -7 Q)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -6 Q)
(CALL APPEND 2)
(MOVE O2 O1)
(MOVE O1 -9 Q)
(CALL CONS 2)
(MOVEM O1 -1 Q)
(MOVE O1 -10 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 -6 Q)
(MOVE O1 O5)
(CALL CONS 2)
(MOVE O5 O1)
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -2 Q)
(MOVE O4 -1 Q)
(MOVEI N 5)
(JRST 3)
(LABEL 6) (MOVE O1 -10 Q)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O2 (CONSTANT 3))
(MOVE O1 O5)
(CALL GET 2)
(MOVEM O1 -9 Q)
(JUMPE O1 14)
(MOVE O5 O1)
(MOVEM O5 -8 Q)
(MOVE O1 -10 Q)
(MOVE O6 O5)
(FCALL 1)
(JRST 3)
(LABEL 14) (MOVE O1 (CONSTANT 4))
(CALL BOUNDP 1)
(JUMPE O1 16)
(SKIPN NIL (SPECIAL 4))
(LABEL 16) (JRST 15)
(MOVE O1 -10 Q)
(CALL LISP::COMPILER-MACROEXPAND-1 1)
(MOVEM O1 -9 Q)
(MOVEM O1 -8 Q)
(MOVE O2 -10 Q)
(CAME O2 -8 Q)
(JRST 18)
(MOVE O1 O2)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 5))
(CALL ERROR 2)
(JRST 19)
(LABEL 18) (MOVE O1 -9 Q)
(CALL GET-SETF-METHOD 1)
(LABEL 19) (JRST 3)
(LABEL 15) (SKIPA)
(JRST 20)
(MOVE O1 -10 Q)
(CALL MACROEXPAND-1 1)
(MOVEM O1 -9 Q)
(MOVEM O1 -8 Q)
(MOVE O2 -10 Q)
(CAME O2 -8 Q)
(JRST 21)
(MOVE O1 O2)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 5))
(CALL ERROR 2)
(JRST 22)
(LABEL 21) (MOVE O1 -9 Q)
(CALL GET-SETF-METHOD 1)
(LABEL 22)
(LABEL 20)
(LABEL 3) (SUBI Q 11)
(POPJ P)
)
(%PUT (QUOTE GET-SETF-METHOD) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (FORM)))
(%PUT (QUOTE GET-SETF-METHOD) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE GET-SETF-METHOD) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE *MACROEXPAND-HOOK*) (QUOTE GLOBALLY-SPECIAL) T)
#_(LAP #0_COMPILER-MACROEXPAND-1 EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(MACRO-IN-COMPILER *MACROEXPAND-HOOK* T)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(MOVEM NIL -1 Q)
(CALL LISTP 1)
(JUMPN O1 4)
(MOVE O2 NIL)
(MOVE O1 -2 Q)
(MOVEI N 2)
(JRST 3)
(LABEL 4) (MOVE O1 -2 Q)
(MOVE O1 0 O1)
(CALL SYMBOLP 1)
(JUMPN O1 5)
(MOVE O2 NIL)
(MOVE O1 -2 Q)
(MOVEI N 2)
(JRST 3)
(LABEL 5) (MOVE O1 -2 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 (CONSTANT 0))
(MOVE O1 O5)
(CALL GET 2)
(MOVEM O1 -1 Q)
(JUMPN1 O1 7)
(MOVE O1 -2 Q)
(MOVE O1 0 O1)
(CALL MACRO-FUNCTION 1)
(MOVEM O1 -1 Q)
(SKIPN NIL O1)
(LABEL 7) (JRST 6)
(MOVE O5 (SPECIAL 1))
(MOVEM O5 0 Q)
(MOVE O2 -2 Q)
(MOVE O1 -1 Q)
(MOVE O6 O5)
(FCALL 2)
(MOVEM O1 0 Q)
(MOVE O2 (CONSTANT 2))
(MOVEI N 2)
(JRST 3)
(LABEL 6) (SKIPA)
(JRST 8)
(MOVE O2 NIL)
(MOVE O1 -2 Q)
(MOVEI N 2)
(LABEL 8)
(LABEL 3) (SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE COMPILER-MACROEXPAND-1) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (FORM)))
(%PUT (QUOTE COMPILER-MACROEXPAND-1) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE COMPILER-MACROEXPAND-1) (QUOTE %SOURCE-DOCUMENTATION))))
#_(LAP #0_COMPILER-MACROEXPAND EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(T)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVEM NIL 0 Q)
(CALL LISP::COMPILER-MACROEXPAND-1 1)
(ADJUST-VALUES 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(SKIPE NIL 0 Q)
(JRST 8)
(MOVE O2 NIL)
(MOVE O1 -1 Q)
(MOVEI N 2)
(JRST 3)
(LABEL 8)
(LABEL 7) (MOVE O1 -1 Q)
(CALL LISP::COMPILER-MACROEXPAND-1 1)
(ADJUST-VALUES 2)
(MOVEM O1 -1 Q)
(MOVEM O2 0 Q)
(SKIPN NIL 0 Q)
(JRST 9)
(JRST 7)
(LABEL 9) (MOVE O2 (CONSTANT 0))
(MOVE O1 -1 Q)
(MOVEI N 2)
(JRST 3)
(MOVE O1 NIL)
(MOVEI N 1)
(LABEL 3) (SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE COMPILER-MACROEXPAND) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (FORM)))
(%PUT (QUOTE COMPILER-MACROEXPAND) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE COMPILER-MACROEXPAND) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE GET-SETF-METHOD-MULTIPLE-VALUE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Like Get-Setf-Method, but may return multiple new-value variables."))
#_(LAP #0_GET-SETF-METHOD-MULTIPLE-VALUE EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_NIL
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(CALL GET-SETF-METHOD 1)
(SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE GET-SETF-METHOD-MULTIPLE-VALUE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (FORM)))
(%PUT (QUOTE GET-SETF-METHOD-MULTIPLE-VALUE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE GET-SETF-METHOD-MULTIPLE-VALUE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DEFINE-SETF-METHOD) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Syntax like DEFMACRO, but creates a Setf-Method generator. The body
must be a form that returns the five magical values."))
#_(LAP #0_DEFINE-SETF-METHOD 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." DEFINE-SETF-METHOD %ARG-COUNT %MIN-ARGS %RESTP %LET-LIST %KEYWORD-TESTS 0 "~S -- Access-function name not a symbol in DEFINE-SETF-METHOD." (NIL) DECLARE (CDR %LAMBDA-LIST) %LAMBDA-LIST > (LENGTH %LAMBDA-LIST) < NOT = OR (IGNORE %LAMBDA-LIST) LET* COND ERROR "Setf expander for ~S cannot be called with ~S args." QUOTE ((1- (LENGTH %LAMBDA-LIST))) T EVAL-WHEN (LOAD COMPILE EVAL) REMPROP ((QUOTE SETF-INVERSE)) %PUT (QUOTE SETF-METHOD-EXPANDER) FUNCTION LAMBDA (%LAMBDA-LIST) (QUOTE %SETF-DOCUMENTATION))
(CODE-START)
(LABEL 1) (ADDI Q 19)
(MOVEM O1 -18 Q)
(CALL LENGTH 1)
(MOVEM O1 -17 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -18 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 -18 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -16 Q)
(MOVE O1 -18 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -15 Q)
(MOVE O1 -18 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -14 Q)
(MOVEM NIL -13 Q)
(MOVEM NIL -12 Q)
(MOVEM NIL -11 Q)
(MOVE O5 (CONSTANT 8))
(MOVEM O5 -10 Q)
(MOVE O5 (CONSTANT 8))
(MOVEM O5 -9 Q)
(MOVEM NIL -8 Q)
(MOVEM NIL -7 Q)
(MOVEM NIL -6 Q)
(MOVE O1 -10 Q)
(SPEC-BIND (SPECIAL 3))
(MOVEM O1 (SPECIAL 3))
(MOVE O1 -9 Q)
(SPEC-BIND (SPECIAL 4))
(MOVEM O1 (SPECIAL 4))
(MOVE O1 -8 Q)
(SPEC-BIND (SPECIAL 5))
(MOVEM O1 (SPECIAL 5))
(MOVE O1 -7 Q)
(SPEC-BIND (SPECIAL 6))
(MOVEM O1 (SPECIAL 6))
(MOVE O1 -6 Q)
(SPEC-BIND (SPECIAL 7))
(MOVEM O1 (SPECIAL 7))
(MOVE O1 -16 Q)
(CALL SYMBOLP 1)
(JUMPN O1 12)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 9))
(CALL ERROR 2)
(LABEL 12)
(LABEL 10) (MOVE O1 -14 Q)
(CALL ATOM 1)
(JUMPE O1 15)
(MOVE O1 (CONSTANT 10))
(MOVEM O1 -14 Q)
(JRST 14)
(LABEL 15) (MOVE O1 -14 Q)
(MOVE O1 0 O1)
(CALL ATOM 1)
(JUMPN O1 17)
(MOVE O1 -14 Q)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(MOVE O2 (CONSTANT 11))
(CAME O2 -5 Q)
(LABEL 17) (JRST 16)
(MOVE O1 -14 Q)
(MOVE O1 0 O1)
(MOVE O2 1 O1)
(MOVE O1 -13 Q)
(CALL APPEND 2)
(MOVEM O1 -13 Q)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(MOVEM O1 -14 Q)
(JRST 10)
(LABEL 16) (MOVE O1 -14 Q)
(MOVE O1 0 O1)
(CALL STRINGP 1)
(JUMPE O1 20)
(MOVE O1 -14 Q)
(SKIPN NIL 1 O1)
(LABEL 20) (JRST 19)
(MOVE O1 -14 Q)
(MOVE O1 0 O1)
(MOVEM O1 -12 Q)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(MOVEM O1 -14 Q)
(JRST 10)
(LABEL 19)
(LABEL 14) (MOVE O4 (CONSTANT 13))
(MOVE O1 -15 Q)
(MOVE O2 (CONSTANT 12))
(MOVE O3 -16 Q)
(CALL LISP::ANALYZE1 4)
(MOVE O1 (SPECIAL 4))
(CALL ZEROP 1)
(JUMPE O1 25)
(SKIPN NIL (SPECIAL 5))
(LABEL 25) (JRST 24)
(MOVE O1 NIL)
(JRST 23)
(LABEL 24) (MOVE O1 (SPECIAL 4))
(CALL ZEROP 1)
(JUMPE O1 27)
(MOVE O1 (SPECIAL 3))
(CALL 1+ 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 14))
(MOVE O2 (CONSTANT 15))
(CALL LIST 3)
(JRST 23)
(LABEL 27) (SKIPN NIL (SPECIAL 5))
(JRST 28)
(MOVE O1 (SPECIAL 4))
(CALL 1+ 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 16))
(MOVE O2 (CONSTANT 15))
(CALL LIST 3)
(JRST 23)
(LABEL 28) (MOVE O5 (SPECIAL 4))
(MOVEM O5 -5 Q)
(MOVE O2 (SPECIAL 3))
(MOVE O1 O5)
(CALL = 2)
(JUMPE O1 29)
(MOVE O1 (SPECIAL 4))
(CALL 1+ 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 18))
(MOVE O2 (CONSTANT 15))
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 17))
(CALL LIST 2)
(JRST 23)
(LABEL 29) (SKIPA)
(JRST 30)
(MOVE O1 (SPECIAL 3))
(CALL 1+ 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 14))
(MOVE O2 (CONSTANT 15))
(CALL LIST 3)
(MOVEM O1 -4 Q)
(MOVE O1 (SPECIAL 4))
(CALL 1+ 1)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 16))
(MOVE O2 (CONSTANT 15))
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 19))
(MOVE O2 -4 Q)
(CALL LIST 3)
(LABEL 30)
(LABEL 23) (MOVEM O1 -11 Q)
(SKIPE NIL -15 Q)
(JRST 33)
(MOVE O2 -13 Q)
(MOVE O1 (CONSTANT 20))
(CALL CONS 2)
(MOVEM O1 -13 Q)
(LABEL 33) (MOVE O1 (SPECIAL 6))
(CALL NREVERSE 1)
(MOVEM O1 -4 Q)
(SKIPN NIL -13 Q)
(JRST 35)
(MOVE O2 -13 Q)
(MOVE O1 (CONSTANT 11))
(CALL CONS 2)
(CALL LIST 1)
(MOVEM O1 -3 Q)
(JRST 36)
(LABEL 35) (MOVEM NIL -3 Q)
(LABEL 36) (MOVE O5 (SPECIAL 7))
(MOVEM O5 -2 Q)
(MOVE O3 -14 Q)
(MOVE O1 -3 Q)
(MOVE O2 O5)
(CALL APPEND 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 21))
(MOVE O2 -4 Q)
(CALL LIST* 3)
(MOVEM O1 -14 Q)
(SKIPN NIL -11 Q)
(JRST 37)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 25))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O4 (CONSTANT 26))
(MOVE O1 (CONSTANT 23))
(MOVE O2 (CONSTANT 24))
(MOVE O3 -1 Q)
(CALL LIST* 4)
(MOVE O2 O1)
(MOVE O1 -11 Q)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -14 Q)
(MOVE O1 (CONSTANT 27))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 22))
(MOVE O2 -4 Q)
(CALL LIST 3)
(MOVEM O1 -14 Q)
(LABEL 37) (MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 25))
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O3 (CONSTANT 31))
(MOVE O1 (CONSTANT 30))
(MOVE O2 -2 Q)
(CALL LIST* 3)
(MOVEM O1 -3 Q)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 25))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O3 -14 Q)
(MOVE O1 (CONSTANT 35))
(MOVE O2 (CONSTANT 36))
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 34))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 32))
(MOVE O2 -1 Q)
(MOVE O3 (CONSTANT 33))
(CALL LIST 4)
(MOVEM O1 -2 Q)
(SKIPN NIL -12 Q)
(JRST 39)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 25))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -12 Q)
(MOVE O1 (CONSTANT 25))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 32))
(MOVE O2 0 Q)
(MOVE O3 (CONSTANT 37))
(CALL LIST 4)
(CALL LIST 1)
(MOVEM O1 -1 Q)
(JRST 40)
(LABEL 39) (MOVEM NIL -1 Q)
(LABEL 40) (MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 25))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL APPEND 2)
(MOVE O5 O1)
(MOVE O1 (CONSTANT 28))
(MOVE O2 (CONSTANT 29))
(MOVE O3 -3 Q)
(MOVE O4 -2 Q)
(CALL LIST* 5)
(UNBIND 5)
(LABEL 5)
(LABEL 3) (SUBI Q 19)
(POPJ P)
)
(%PUT (QUOTE DEFINE-SETF-METHOD) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (ACCESS-FN LAMBDA-LIST &BODY BODY)))
(%PUT (QUOTE DEFINE-SETF-METHOD) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DEFINE-SETF-METHOD) (QUOTE %SOURCE-DOCUMENTATION))))
#_(LAP #0_DEFSETTER EXPR
(ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(%ARG-COUNT %MIN-ARGS %RESTP %LET-LIST %KEYWORD-TESTS 0 (NIL) DECLARE (CDR %ACCESS-ARGLIST) %ACCESS-ARGLIST (IGNORE %ACCESS-ARGLIST) LET* LAMBDA)
(CODE-START)
(LABEL 1) (ADDI Q 15)
(MOVEM O1 -14 Q)
(MOVEM O2 -13 Q)
(MOVE O1 O2)
(MOVE O5 0 O1)
(MOVEM O5 -12 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -11 Q)
(MOVE O1 O2)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -10 Q)
(MOVEM NIL -9 Q)
(MOVE O5 (CONSTANT 5))
(MOVEM O5 -8 Q)
(MOVE O5 (CONSTANT 5))
(MOVEM O5 -7 Q)
(MOVEM NIL -6 Q)
(MOVEM NIL -5 Q)
(MOVEM NIL -4 Q)
(MOVE O1 -8 Q)
(SPEC-BIND (SPECIAL 0))
(MOVEM O1 (SPECIAL 0))
(MOVE O1 -7 Q)
(SPEC-BIND (SPECIAL 1))
(MOVEM O1 (SPECIAL 1))
(MOVE O1 -6 Q)
(SPEC-BIND (SPECIAL 2))
(MOVEM O1 (SPECIAL 2))
(MOVE O1 -5 Q)
(SPEC-BIND (SPECIAL 3))
(MOVEM O1 (SPECIAL 3))
(MOVE O1 -4 Q)
(SPEC-BIND (SPECIAL 4))
(MOVEM O1 (SPECIAL 4))
(LABEL 6) (MOVE O1 -10 Q)
(CALL ATOM 1)
(JUMPE O1 8)
(MOVE O1 (CONSTANT 6))
(MOVEM O1 -10 Q)
(JRST 7)
(LABEL 8) (MOVE O1 -10 Q)
(MOVE O1 0 O1)
(CALL ATOM 1)
(JUMPN O1 10)
(MOVE O1 -10 Q)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -3 Q)
(MOVE O2 (CONSTANT 7))
(CAME O2 -3 Q)
(LABEL 10) (JRST 9)
(MOVE O1 -10 Q)
(MOVE O1 0 O1)
(MOVE O2 1 O1)
(MOVE O1 -9 Q)
(CALL APPEND 2)
(MOVEM O1 -9 Q)
(MOVE O1 -10 Q)
(MOVE O1 1 O1)
(MOVEM O1 -10 Q)
(JRST 6)
(LABEL 9) (MOVE O1 -10 Q)
(MOVE O1 0 O1)
(CALL STRINGP 1)
(JUMPE O1 13)
(MOVE O1 -10 Q)
(SKIPN NIL 1 O1)
(LABEL 13) (JRST 12)
(MOVE O1 -10 Q)
(MOVE O1 1 O1)
(MOVEM O1 -10 Q)
(JRST 6)
(LABEL 12)
(LABEL 7) (MOVE O4 (CONSTANT 9))
(MOVE O1 -12 Q)
(MOVE O2 (CONSTANT 8))
(MOVE O3 -14 Q)
(CALL LISP::ANALYZE1 4)
(SKIPE NIL -12 Q)
(JRST 17)
(MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 10))
(CALL CONS 2)
(MOVEM O1 -9 Q)
(LABEL 17) (MOVE O1 (SPECIAL 3))
(CALL NREVERSE 1)
(MOVEM O1 -2 Q)
(SKIPN NIL -9 Q)
(JRST 19)
(MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 7))
(CALL CONS 2)
(CALL LIST 1)
(MOVEM O1 -1 Q)
(JRST 20)
(LABEL 19) (MOVEM NIL -1 Q)
(LABEL 20) (MOVE O5 (SPECIAL 4))
(MOVEM O5 0 Q)
(MOVE O3 -10 Q)
(MOVE O1 -1 Q)
(MOVE O2 O5)
(CALL APPEND 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -2 Q)
(CALL LIST* 3)
(MOVEM O1 -10 Q)
(MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 9))
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O3 -10 Q)
(MOVE O1 (CONSTANT 12))
(MOVE O2 -2 Q)
(CALL LIST 3)
(UNBIND 5)
(SUBI Q 15)
(POPJ P)
)
(%PUT (QUOTE DEFSETTER) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (FN REST)))
(%PUT (QUOTE DEFSETTER) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DEFSETTER) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DEFSETF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Associates a SETF update function or macro with the specified access
function or macro. The format is complex. See the manual for
details."))
#_(LAP #0_DEFSETF 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." DEFSETF EVAL-WHEN (LOAD COMPILE EVAL) REMPROP QUOTE ((QUOTE SETF-METHOD-EXPANDER)) %PUT (QUOTE SETF-INVERSE) (LOAD EVAL) (QUOTE %SETF-DOCUMENTATION) 1 "Ignore the extra items in the list." "Only one new-value variable allowed in DEFSETF." DECLARATION ((QUOTE SETF-INVERSE)) (QUOTE SETF-METHOD-EXPANDER) FUNCTION LAMBDA (ACCESS-FORM) DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) (ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) FUNCALL (NEW-ACCESS-FORM NEWVAL-VAR) (NEW-ACCESS-FORM) ((QUOTE %SETF-DOCUMENTATION)) "Ill-formed DEFSETF for ~S.")
(CODE-START)
(LABEL 1) (ADDI Q 19)
(MOVEM O1 -18 Q)
(CALL LENGTH 1)
(MOVEM O1 -17 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -18 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 -18 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -16 Q)
(MOVE O1 -18 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -15 Q)
(MOVE O1 O5)
(MOVE O1 0 O1)
(CALL LISTP 1)
(JUMPN O1 7)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -11 Q)
(MOVE O3 (CONSTANT 7))
(MOVE O1 (CONSTANT 5))
(MOVE O2 -11 Q)
(CALL LIST* 3)
(MOVEM O1 -12 Q)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -10 Q)
(MOVE O1 -15 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -10 Q)
(MOVE O3 (CONSTANT 9))
(CALL LIST 4)
(MOVEM O1 -11 Q)
(MOVE O1 -15 Q)
(SKIPN NIL 0 O1)
(JRST 10)
(MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(CALL STRINGP 1)
(SKIPN NIL O1)
(LABEL 10) (JRST 8)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -7 Q)
(MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVE O4 0 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -7 Q)
(MOVE O3 (CONSTANT 11))
(CALL LIST 4)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 (CONSTANT 10))
(CALL LIST 3)
(CALL LIST 1)
(MOVEM O1 -10 Q)
(JRST 9)
(LABEL 8) (MOVEM NIL -10 Q)
(LABEL 9) (MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -10 Q)
(CALL APPEND 2)
(MOVE O5 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 (CONSTANT 4))
(MOVE O3 -12 Q)
(MOVE O4 -11 Q)
(CALL LIST* 5)
(JRST 6)
(LABEL 7) (MOVE O1 -15 Q)
(MOVE O1 0 O1)
(CALL LISTP 1)
(JUMPE O1 13)
(MOVE O1 -15 Q)
(SKIPN NIL 1 O1)
(JRST 13)
(MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(CALL LISTP 1)
(SKIPN NIL O1)
(LABEL 13) (JRST 12)
(MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(CALL LENGTH 1)
(MOVEM O1 -14 Q)
(MOVE O2 (CONSTANT 12))
(CALL = 2)
(JUMPN O1 15)
(MOVE O2 (CONSTANT 14))
(MOVE O1 (CONSTANT 13))
(CALL CERROR 2)
(LABEL 15) (MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -11 Q)
(LABEL 21) (MOVE O1 -11 Q)
(CALL ATOM 1)
(JUMPN1 O1 24)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(CALL ATOM 1)
(SKIPN NIL O1)
(LABEL 24) (JRST 22)
(MOVEM NIL -13 Q)
(JRST 17)
(LABEL 22) (MOVE O1 -11 Q)
(MOVE O1 0 O1)
(CALL STRINGP 1)
(JUMPE O1 26)
(MOVE O1 -11 Q)
(MOVE O5 0 O1)
(MOVEM O5 -13 Q)
(JRST 17)
(LABEL 26) (MOVE O1 -11 Q)
(MOVE O1 0 O1)
(CALL LISTP 1)
(JUMPE1 O1 28)
(MOVE O1 -11 Q)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -10 Q)
(MOVE O2 (CONSTANT 15))
(CAMN O2 -10 Q)
(LABEL 28) (JRST 25)
(MOVEM NIL -13 Q)
(JRST 17)
(LABEL 25) (MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVEM O1 -11 Q)
(JRST 21)
(LABEL 17) (MOVE O2 -15 Q)
(MOVE O1 -16 Q)
(CALL LISP::DEFSETTER 2)
(MOVEM O1 -12 Q)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -8 Q)
(MOVE O3 (CONSTANT 16))
(MOVE O1 (CONSTANT 5))
(MOVE O2 -8 Q)
(CALL LIST* 3)
(MOVEM O1 -9 Q)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -7 Q)
(MOVE O5 (CONSTANT 25))
(MOVEM O5 -5 Q)
(MOVE O5 (CONSTANT 26))
(MOVEM O5 -4 Q)
(MOVE O5 (CONSTANT 27))
(MOVEM O5 -3 Q)
(MOVE O5 (CONSTANT 28))
(MOVEM O5 -2 Q)
(MOVE O2 -12 Q)
(MOVE O1 (CONSTANT 18))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O3 (CONSTANT 30))
(MOVE O1 (CONSTANT 29))
(MOVE O2 0 Q)
(CALL LIST* 3)
(MOVEM O1 -1 Q)
(PUSH Q (CONSTANT 31))
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVE O5 -2 Q)
(CALL LIST* 6)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 23))
(MOVE O2 (CONSTANT 24))
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 21))
(MOVE O2 (CONSTANT 22))
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 19))
(MOVE O2 (CONSTANT 20))
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 18))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -7 Q)
(MOVE O3 (CONSTANT 17))
(CALL LIST 4)
(MOVEM O1 -8 Q)
(SKIPN NIL -13 Q)
(JRST 32)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -6 Q)
(MOVE O2 -13 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -6 Q)
(MOVE O3 (CONSTANT 11))
(CALL LIST 4)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 (CONSTANT 10))
(CALL LIST 3)
(CALL LIST 1)
(MOVEM O1 -7 Q)
(JRST 33)
(LABEL 32) (MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -6 Q)
(MOVE O3 (CONSTANT 32))
(MOVE O1 (CONSTANT 5))
(MOVE O2 -6 Q)
(CALL LIST* 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 (CONSTANT 10))
(CALL LIST 3)
(CALL LIST 1)
(MOVEM O1 -7 Q)
(LABEL 33) (MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -7 Q)
(CALL APPEND 2)
(MOVE O5 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 (CONSTANT 4))
(MOVE O3 -9 Q)
(MOVE O4 -8 Q)
(CALL LIST* 5)
(JRST 6)
(LABEL 12) (SKIPA)
(JRST 34)
(MOVE O2 -16 Q)
(MOVE O1 (CONSTANT 33))
(CALL ERROR 2)
(LABEL 34)
(LABEL 6)
(LABEL 5)
(LABEL 3) (SUBI Q 19)
(POPJ P)
)
(%PUT (QUOTE DEFSETF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (ACCESS-FN &REST REST)))
(%PUT (QUOTE DEFSETF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DEFSETF) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE SETF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Takes pairs of arguments like SETQ. The first is a place and the second
is the value that is supposed to go into that place. Returns the last
value. The place argument may be any of the access forms for which SETF
knows a corresponding setting form."))
#_(LAP #0_SETF MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(2 SETQ SETF-INVERSE LET* 1 "Odd number of args to SETF." PROGN SETF)
(CODE-START)
(LABEL 1) (ADDI Q 13)
(MOVEM O1 -12 Q)
(MOVE O5 1 O1)
(MOVEM O5 -11 Q)
(MOVE O1 O5)
(CALL LENGTH 1)
(MOVEM O1 -10 Q)
(MOVE O2 (CONSTANT 0))
(CALL = 2)
(JUMPE O1 4)
(MOVE O1 -11 Q)
(MOVE O1 0 O1)
(CALL ATOM 1)
(JUMPE O1 6)
(MOVE O1 -11 Q)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O1 1 O1)
(MOVE O3 0 O1)
(MOVE O1 (CONSTANT 1))
(MOVE O2 O5)
(CALL LIST 3)
(JRST 5)
(LABEL 6) (MOVE O1 -11 Q)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -9 Q)
(MOVE O2 (CONSTANT 2))
(MOVE O1 O5)
(CALL GET 2)
(MOVEM O1 -10 Q)
(JUMPE O1 7)
(MOVE O1 -11 Q)
(MOVE O1 0 O1)
(MOVE O5 1 O1)
(MOVEM O5 -8 Q)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -8 Q)
(CALL APPEND 2)
(MOVE O2 O1)
(MOVE O1 -10 Q)
(CALL CONS 2)
(JRST 5)
(LABEL 7) (SKIPA)
(JRST 8)
(MOVE O1 -11 Q)
(MOVE O1 0 O1)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -8 Q)
(MOVEM O2 -7 Q)
(MOVEM O3 -6 Q)
(MOVEM O4 -5 Q)
(MOVEM O5 -4 Q)
(MOVE O5 O1)
(MOVEM O5 -3 Q)
(MOVE O5 O2)
(MOVEM O5 -2 Q)
(MOVEM NIL -1 Q)
(LABEL 13) (SKIPE NIL -3 Q)
(JRST 14)
(MOVE O1 -6 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(CALL CONS 2)
(CALL NREVERSE 1)
(MOVEM O1 -1 Q)
(MOVE O3 -5 Q)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -1 Q)
(CALL LIST 3)
(JRST 9)
(LABEL 14) (MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 -2 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -1 Q)
(CALL CONS 2)
(MOVEM O1 -1 Q)
(MOVE O1 -3 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(MOVE O1 -2 Q)
(MOVE O1 1 O1)
(MOVEM O1 -2 Q)
(JRST 13)
(LABEL 9)
(LABEL 8)
(LABEL 5) (JRST 3)
(LABEL 4) (MOVE O3 (CONSTANT 4))
(MOVE O1 (CONSTANT 4))
(MOVE O2 -10 Q)
(CALL BOOLE 3)
(CALL ZEROP 1)
(JUMPN O1 17)
(MOVE O1 (CONSTANT 5))
(CALL ERROR 1)
(JRST 3)
(LABEL 17) (SKIPA)
(JRST 18)
(MOVE O5 -11 Q)
(MOVEM O5 -8 Q)
(MOVEM NIL -7 Q)
(LABEL 23) (SKIPE NIL -8 Q)
(JRST 24)
(MOVE O1 -7 Q)
(CALL NREVERSE 1)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 6))
(CALL CONS 2)
(JRST 19)
(LABEL 24) (MOVE O1 -8 Q)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(MOVE O1 1 O1)
(MOVE O3 0 O1)
(MOVE O1 (CONSTANT 7))
(MOVE O2 O5)
(CALL LIST 3)
(MOVEM O1 -6 Q)
(MOVE O2 -7 Q)
(CALL CONS 2)
(MOVEM O1 -7 Q)
(MOVE O1 -8 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVEM O1 -8 Q)
(JRST 23)
(LABEL 19)
(LABEL 18)
(LABEL 3) (SUBI Q 13)
(POPJ P)
)
(%PUT (QUOTE SETF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST ARGS)))
(%PUT (QUOTE SETF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE SETF) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE PSETF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "This is to SETF as PSETQ is to SETQ. Args are alternating place
expressions and values to go into those places. All of the subforms and
values are determined, left to right, and only then are the locations
updated. Returns NIL."))
#_(LAP #0_PSETF MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(LET* (NIL) "Odd number of args to PSETF.")
(CODE-START)
(LABEL 1) (ADDI Q 14)
(MOVEM O1 -13 Q)
(MOVE O5 1 O1)
(MOVEM O5 -12 Q)
(MOVEM O5 -11 Q)
(MOVEM NIL -10 Q)
(MOVEM NIL -9 Q)
(LABEL 7) (MOVE O1 -11 Q)
(CALL ATOM 1)
(JUMPE O1 8)
(MOVE O1 -10 Q)
(CALL NREVERSE 1)
(MOVEM O1 -8 Q)
(MOVE O1 -9 Q)
(CALL NREVERSE 1)
(MOVEM O1 -7 Q)
(MOVE O2 (CONSTANT 1))
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -8 Q)
(CALL LIST* 3)
(JRST 3)
(LABEL 8) (MOVE O1 -11 Q)
(MOVE O1 1 O1)
(CALL ATOM 1)
(JUMPE O1 10)
(MOVE O1 (CONSTANT 2))
(CALL ERROR 1)
(LABEL 10) (MOVE O1 -11 Q)
(MOVE O1 0 O1)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -8 Q)
(MOVEM O2 -7 Q)
(MOVEM O3 -6 Q)
(MOVEM O4 -5 Q)
(MOVEM O5 -4 Q)
(MOVE O5 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 16) (SKIPE NIL -2 Q)
(JRST 17)
(JRST 12)
(LABEL 17) (MOVE O1 -2 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 -1 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -10 Q)
(CALL CONS 2)
(MOVEM O1 -10 Q)
(MOVE O1 -2 Q)
(MOVE O1 1 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 16)
(LABEL 12) (MOVE O1 -6 Q)
(MOVE O5 0 O1)
(MOVEM O5 -3 Q)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O2 -10 Q)
(CALL CONS 2)
(MOVEM O1 -10 Q)
(MOVE O2 -9 Q)
(MOVE O1 -5 Q)
(CALL CONS 2)
(MOVEM O1 -9 Q)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVEM O1 -11 Q)
(JRST 7)
(LABEL 3) (SUBI Q 14)
(POPJ P)
)
(%PUT (QUOTE PSETF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST ARGS)))
(%PUT (QUOTE PSETF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE PSETF) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE SHIFTF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "One or more SETF-style place expressions, followed by a single
value expression. Evaluates all of the expressions in turn, then
assigns the value of each expression to the place on its left,
returning the value of the leftmost."))
#_(LAP #0_SHIFTF MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(2 "Too few argument forms to a SHIFTF." LET*)
(CODE-START)
(LABEL 1) (ADDI Q 18)
(MOVEM O1 -17 Q)
(MOVE O5 1 O1)
(MOVEM O5 -16 Q)
(MOVE O1 O5)
(CALL LENGTH 1)
(MOVEM O1 -15 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 3)
(MOVE O1 (CONSTANT 1))
(CALL ERROR 1)
(LABEL 3) (CALL GENSYM 0)
(MOVEM O1 -14 Q)
(MOVE O5 -16 Q)
(MOVEM O5 -13 Q)
(MOVEM NIL -12 Q)
(MOVEM NIL -11 Q)
(MOVE O5 O1)
(MOVEM O5 -10 Q)
(LABEL 9) (MOVE O1 -13 Q)
(MOVE O1 1 O1)
(CALL ATOM 1)
(JUMPE O1 10)
(MOVE O1 -13 Q)
(MOVE O2 0 O1)
(MOVE O1 -10 Q)
(CALL LIST 2)
(MOVEM O1 -9 Q)
(MOVE O2 -12 Q)
(CALL CONS 2)
(MOVEM O1 -12 Q)
(CALL NREVERSE 1)
(MOVEM O1 -8 Q)
(MOVE O1 -11 Q)
(CALL NREVERSE 1)
(MOVEM O1 -7 Q)
(MOVE O1 -14 Q)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -7 Q)
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 2))
(MOVE O2 -8 Q)
(CALL LIST* 3)
(JRST 5)
(LABEL 10) (MOVE O1 -13 Q)
(MOVE O1 0 O1)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -8 Q)
(MOVEM O2 -7 Q)
(MOVEM O3 -6 Q)
(MOVEM O4 -5 Q)
(MOVEM O5 -4 Q)
(MOVE O5 O1)
(MOVEM O5 -2 Q)
(MOVE O5 O2)
(MOVEM O5 -1 Q)
(LABEL 16) (SKIPE NIL -2 Q)
(JRST 17)
(JRST 12)
(LABEL 17) (MOVE O1 -2 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 -1 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -12 Q)
(CALL CONS 2)
(MOVEM O1 -12 Q)
(MOVE O1 -2 Q)
(MOVE O1 1 O1)
(MOVEM O1 -2 Q)
(MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 16)
(LABEL 12) (MOVE O2 -4 Q)
(MOVE O1 -10 Q)
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O2 -12 Q)
(CALL CONS 2)
(MOVEM O1 -12 Q)
(MOVE O2 -11 Q)
(MOVE O1 -5 Q)
(CALL CONS 2)
(MOVEM O1 -11 Q)
(MOVE O1 -6 Q)
(MOVE O1 0 O1)
(MOVEM O1 -10 Q)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVEM O1 -13 Q)
(JRST 9)
(LABEL 5) (SUBI Q 18)
(POPJ P)
)
(%PUT (QUOTE SHIFTF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST ARGS)))
(%PUT (QUOTE SHIFTF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE SHIFTF) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ROTATEF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Takes any number of SETF-style place expressions. Evaluates all of the
expressions in turn, then assigns to each place the value of the form to
its right. The rightmost form gets the value of the leftmost. Returns NIL."))
#_(LAP #0_ROTATEF MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(PROGN (NIL) LET*)
(CODE-START)
(LABEL 1) (ADDI Q 17)
(MOVEM O1 -16 Q)
(MOVE O5 1 O1)
(MOVEM O5 -15 Q)
(SKIPE NIL -15 Q)
(JRST 4)
(MOVE O1 NIL)
(MOVEI N 1)
(JRST 3)
(LABEL 4) (MOVE O1 -15 Q)
(SKIPE NIL 1 O1)
(JRST 5)
(MOVE O1 -15 Q)
(MOVE O5 0 O1)
(MOVEM O5 -14 Q)
(MOVE O3 (CONSTANT 1))
(MOVE O1 (CONSTANT 0))
(MOVE O2 O5)
(CALL LIST* 3)
(JRST 3)
(LABEL 5) (SKIPA)
(JRST 6)
(MOVE O5 -15 Q)
(MOVEM O5 -14 Q)
(MOVEM NIL -13 Q)
(MOVEM NIL -12 Q)
(MOVEM NIL -11 Q)
(MOVEM NIL -10 Q)
(LABEL 11) (MOVE O1 -14 Q)
(CALL ATOM 1)
(JUMPE O1 12)
(MOVE O2 -11 Q)
(MOVE O1 -10 Q)
(CALL RPLACA 2)
(MOVE O1 -13 Q)
(CALL NREVERSE 1)
(MOVEM O1 -9 Q)
(MOVE O1 -12 Q)
(CALL NREVERSE 1)
(MOVEM O1 -8 Q)
(MOVE O2 (CONSTANT 1))
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 2))
(MOVE O2 -9 Q)
(CALL LIST* 3)
(JRST 7)
(LABEL 12) (MOVE O1 -14 Q)
(MOVE O1 0 O1)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -9 Q)
(MOVEM O2 -8 Q)
(MOVEM O3 -7 Q)
(MOVEM O4 -6 Q)
(MOVEM O5 -5 Q)
(MOVE O5 O1)
(MOVEM O5 -3 Q)
(MOVE O5 O2)
(MOVEM O5 -2 Q)
(LABEL 18) (SKIPE NIL -3 Q)
(JRST 19)
(JRST 14)
(LABEL 19) (MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O1 -2 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O2 -13 Q)
(CALL CONS 2)
(MOVEM O1 -13 Q)
(MOVE O1 -3 Q)
(MOVE O5 1 O1)
(MOVEM O5 -1 Q)
(MOVE O1 -2 Q)
(MOVE O5 1 O1)
(MOVEM O5 0 Q)
(MOVE O1 -1 Q)
(MOVEM O1 -3 Q)
(MOVE O1 O5)
(MOVEM O1 -2 Q)
(JRST 18)
(LABEL 14) (MOVE O2 -5 Q)
(MOVE O1 -11 Q)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -13 Q)
(CALL CONS 2)
(MOVEM O1 -13 Q)
(SKIPE NIL -10 Q)
(JRST 22)
(MOVE O1 -13 Q)
(MOVE O1 0 O1)
(MOVEM O1 -10 Q)
(LABEL 22) (MOVE O2 -12 Q)
(MOVE O1 -6 Q)
(CALL CONS 2)
(MOVEM O1 -12 Q)
(MOVE O1 -7 Q)
(MOVE O1 0 O1)
(MOVEM O1 -11 Q)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(MOVEM O1 -14 Q)
(JRST 11)
(LABEL 7)
(LABEL 6)
(LABEL 3) (SUBI Q 17)
(POPJ P)
)
(%PUT (QUOTE ROTATEF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST ARGS)))
(%PUT (QUOTE ROTATEF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE ROTATEF) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DEFINE-MODIFY-MACRO) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Creates a new read-modify-write macro like PUSH or INCF."))
#_(LAP #0_DEFINE-MODIFY-MACRO MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(5 4 "Macro ~S cannot be called with ~S args." DEFINE-MODIFY-MACRO &OPTIONAL &REST "Non-symbol &rest arg in definition of ~S." "Illegal stuff after &rest arg in Define-Modify-Macro." (&KEY &ALLOW-OTHER-KEYS &AUX) "~S not allowed in Define-Modify-Macro lambda list." "Illegal stuff in lambda list of Define-Modify-Macro." DEFMACRO %REFERENCE MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) (GET-SETF-METHOD %REFERENCE) DO ((D DUMMIES (CDR D)) (V VALS (CDR V)) (LET-LIST NIL (CONS (LIST (CAR D) (CAR V)) LET-LIST))) (NULL D) PUSH LIST (CAR NEWVAL) LIST* QUOTE GETTER (LET-LIST) ((LIST (QUOTE LET*) (NREVERSE LET-LIST) SETTER)))
(CODE-START)
(LABEL 1) (ADDI Q 14)
(MOVEM O1 -13 Q)
(CALL LENGTH 1)
(MOVEM O1 -12 Q)
(MOVE O2 (CONSTANT 0))
(CALL > 2)
(JUMPN1 O1 5)
(MOVE O1 -13 Q)
(CALL LENGTH 1)
(MOVEM O1 -12 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O1 -13 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 -13 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -11 Q)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -10 Q)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -9 Q)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 8)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(JRST 7)
(LABEL 8) (SKIPA)
(JRST 9)
(MOVEM NIL -8 Q)
(LABEL 9)
(LABEL 7) (MOVEM NIL -7 Q)
(MOVEM NIL -6 Q)
(MOVE O5 -10 Q)
(MOVEM O5 -5 Q)
(MOVEM NIL -4 Q)
(LABEL 15) (SKIPE NIL -5 Q)
(JRST 16)
(JRST 11)
(LABEL 16) (MOVE O1 -5 Q)
(MOVE O1 0 O1)
(MOVEM O1 -4 Q)
(MOVE O2 (CONSTANT 4))
(CAMN O2 -4 Q)
(JRST 18)
(MOVE O2 (CONSTANT 5))
(CAME O2 -4 Q)
(JRST 20)
(MOVE O1 -5 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(CALL SYMBOLP 1)
(JUMPE O1 21)
(MOVE O1 -5 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVEM O1 -6 Q)
(JRST 22)
(LABEL 21) (MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 6))
(CALL ERROR 2)
(LABEL 22) (MOVE O1 -5 Q)
(MOVE O1 1 O1)
(SKIPE NIL 1 O1)
(JRST 23)
(JRST 11)
(LABEL 23) (MOVE O1 (CONSTANT 7))
(CALL ERROR 1)
(JRST 18)
(LABEL 20) (MOVE O2 (CONSTANT 8))
(MOVE O1 -4 Q)
(CALL MEMQ 2)
(JUMPE O1 25)
(MOVE O2 -4 Q)
(MOVE O1 (CONSTANT 9))
(CALL ERROR 2)
(JRST 18)
(LABEL 25) (MOVE O1 -4 Q)
(CALL SYMBOLP 1)
(JUMPE O1 26)
(MOVE O2 -7 Q)
(MOVE O1 -4 Q)
(CALL CONS 2)
(MOVEM O1 -7 Q)
(JRST 18)
(LABEL 26) (MOVE O1 -4 Q)
(CALL LISTP 1)
(JUMPE O1 28)
(MOVE O1 -4 Q)
(MOVE O1 0 O1)
(CALL SYMBOLP 1)
(SKIPN NIL O1)
(LABEL 28) (JRST 27)
(MOVE O1 -4 Q)
(MOVE O5 0 O1)
(MOVEM O5 -3 Q)
(MOVE O2 -7 Q)
(MOVE O1 O5)
(CALL CONS 2)
(MOVEM O1 -7 Q)
(JRST 18)
(LABEL 27) (SKIPA)
(JRST 30)
(MOVE O1 (CONSTANT 10))
(CALL ERROR 1)
(LABEL 30)
(LABEL 18) (MOVE O1 -5 Q)
(MOVE O1 1 O1)
(MOVEM O1 -5 Q)
(JRST 15)
(LABEL 11) (MOVE O1 -7 Q)
(CALL NREVERSE 1)
(MOVEM O1 -7 Q)
(MOVE O2 -10 Q)
(MOVE O1 (CONSTANT 12))
(CALL CONS 2)
(MOVEM O1 -4 Q)
(SKIPN NIL -6 Q)
(JRST 32)
(MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 23))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O1 -6 Q)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -7 Q)
(CALL APPEND 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 22))
(MOVE O2 0 Q)
(MOVE O3 (CONSTANT 24))
(CALL LIST* 4)
(MOVE O3 O1)
(JRST 33)
(LABEL 32) (MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 23))
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O4 -7 Q)
(MOVE O1 (CONSTANT 20))
(MOVE O2 0 Q)
(MOVE O3 (CONSTANT 24))
(CALL LIST* 4)
(MOVE O3 O1)
(LABEL 33) (MOVE O1 (CONSTANT 20))
(MOVE O2 (CONSTANT 21))
(CALL LIST 3)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 25))
(MOVE O1 (CONSTANT 19))
(MOVE O2 -1 Q)
(CALL LIST* 3)
(MOVEM O1 -2 Q)
(MOVE O3 (CONSTANT 26))
(MOVE O1 (CONSTANT 18))
(MOVE O2 -2 Q)
(CALL LIST* 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 16))
(MOVE O2 (CONSTANT 17))
(CALL LIST 3)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 13))
(MOVE O2 (CONSTANT 14))
(MOVE O3 (CONSTANT 15))
(CALL LIST 4)
(MOVE O5 O1)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -11 Q)
(MOVE O3 -4 Q)
(MOVE O4 -8 Q)
(CALL LIST 5)
(LABEL 6)
(LABEL 3) (SUBI Q 14)
(POPJ P)
)
(%PUT (QUOTE DEFINE-MODIFY-MACRO) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NAME LAMBDA-LIST FUNCTION &OPTIONAL DOC-STRING)))
(%PUT (QUOTE DEFINE-MODIFY-MACRO) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DEFINE-MODIFY-MACRO) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE PUSH) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Takes an object and a location holding a list. Conses the object onto
the list, returning the modified list."))
#_(LAP #0_PUSH 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." PUSH SETQ CONS LET*)
(CODE-START)
(LABEL 1) (ADDI Q 14)
(MOVEM O1 -13 Q)
(CALL LENGTH 1)
(MOVEM O1 -12 Q)
(MOVE O2 (CONSTANT 0))
(CALL = 2)
(JUMPN O1 4)
(MOVE O1 -13 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 -13 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -11 Q)
(MOVE O1 -13 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -10 Q)
(MOVE O1 O5)
(CALL SYMBOLP 1)
(JUMPE O1 6)
(MOVE O3 -10 Q)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -11 Q)
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -10 Q)
(CALL LIST 3)
(JRST 7)
(LABEL 6) (MOVE O1 -10 Q)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -9 Q)
(MOVEM O2 -8 Q)
(MOVEM O3 -7 Q)
(MOVEM O4 -6 Q)
(MOVEM O5 -5 Q)
(MOVE O5 O1)
(MOVEM O5 -4 Q)
(MOVE O5 O2)
(MOVEM O5 -3 Q)
(MOVEM NIL -2 Q)
(LABEL 12) (SKIPE NIL -4 Q)
(JRST 13)
(MOVE O1 -7 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O3 -5 Q)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -11 Q)
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O2 -2 Q)
(CALL CONS 2)
(MOVEM O1 -2 Q)
(CALL NREVERSE 1)
(MOVEM O1 0 Q)
(MOVE O3 -6 Q)
(MOVE O1 (CONSTANT 5))
(MOVE O2 0 Q)
(CALL LIST 3)
(JRST 8)
(LABEL 13) (MOVE O1 -4 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O1 -3 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O2 -2 Q)
(CALL CONS 2)
(MOVEM O1 -2 Q)
(MOVE O1 -4 Q)
(MOVE O1 1 O1)
(MOVEM O1 -4 Q)
(MOVE O1 -3 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(JRST 12)
(LABEL 8)
(LABEL 7)
(LABEL 5)
(LABEL 3) (SUBI Q 14)
(POPJ P)
)
(%PUT (QUOTE PUSH) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (OBJ PLACE)))
(%PUT (QUOTE PUSH) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE PUSH) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE PUSHNEW) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Takes an object and a location holding a list. If the object is already
in the list, does nothing. Else, conses the object onto the list. Returns
NIL. If there is a :TEST keyword, this is used for the comparison."))
#_(LAP #0_PUSHNEW 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." PUSHNEW SETQ ADJOIN LET*)
(CODE-START)
(LABEL 1) (ADDI Q 15)
(MOVEM O1 -14 Q)
(CALL LENGTH 1)
(MOVEM O1 -13 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -14 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 -14 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -12 Q)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -11 Q)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -10 Q)
(MOVE O1 -11 Q)
(CALL SYMBOLP 1)
(JUMPE O1 6)
(MOVE O4 -10 Q)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -12 Q)
(MOVE O3 -11 Q)
(CALL LIST* 4)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -11 Q)
(CALL LIST 3)
(JRST 7)
(LABEL 6) (MOVE O1 -11 Q)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -9 Q)
(MOVEM O2 -8 Q)
(MOVEM O3 -7 Q)
(MOVEM O4 -6 Q)
(MOVEM O5 -5 Q)
(MOVE O5 O1)
(MOVEM O5 -4 Q)
(MOVE O5 O2)
(MOVEM O5 -3 Q)
(MOVEM NIL -2 Q)
(LABEL 12) (SKIPE NIL -4 Q)
(JRST 13)
(MOVE O1 -7 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O4 -10 Q)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -12 Q)
(MOVE O3 -5 Q)
(CALL LIST* 4)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O2 -2 Q)
(CALL CONS 2)
(MOVEM O1 -2 Q)
(CALL NREVERSE 1)
(MOVEM O1 0 Q)
(MOVE O3 -6 Q)
(MOVE O1 (CONSTANT 5))
(MOVE O2 0 Q)
(CALL LIST 3)
(JRST 8)
(LABEL 13) (MOVE O1 -4 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O1 -3 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O2 -2 Q)
(CALL CONS 2)
(MOVEM O1 -2 Q)
(MOVE O1 -4 Q)
(MOVE O1 1 O1)
(MOVEM O1 -4 Q)
(MOVE O1 -3 Q)
(MOVE O1 1 O1)
(MOVEM O1 -3 Q)
(JRST 12)
(LABEL 8)
(LABEL 7)
(LABEL 5)
(LABEL 3) (SUBI Q 15)
(POPJ P)
)
(%PUT (QUOTE PUSHNEW) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (OBJ PLACE &REST KEYS)))
(%PUT (QUOTE PUSHNEW) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE PUSHNEW) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE POP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The argument is a location holding a list. Pops one item off the front
of the list and returns it."))
#_(LAP #0_POP 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." POP PROG1 CAR SETQ CDR LET*)
(CODE-START)
(LABEL 1) (ADDI Q 16)
(MOVEM O1 -15 Q)
(CALL LENGTH 1)
(MOVEM O1 -14 Q)
(MOVE O2 (CONSTANT 0))
(CALL = 2)
(JUMPN 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 O5)
(CALL SYMBOLP 1)
(JUMPE O1 6)
(MOVE O2 -13 Q)
(MOVE O1 (CONSTANT 4))
(CALL LIST 2)
(MOVEM O1 -12 Q)
(MOVE O2 -13 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 5))
(MOVE O2 -13 Q)
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -12 Q)
(CALL LIST 3)
(JRST 7)
(LABEL 6) (MOVE O1 -13 Q)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -12 Q)
(MOVEM O2 -11 Q)
(MOVEM O3 -10 Q)
(MOVEM O4 -9 Q)
(MOVEM O5 -8 Q)
(MOVE O5 O1)
(MOVEM O5 -7 Q)
(MOVE O5 O2)
(MOVEM O5 -6 Q)
(MOVEM NIL -5 Q)
(LABEL 12) (SKIPE NIL -7 Q)
(JRST 13)
(MOVE O1 -10 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O2 -8 Q)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -5 Q)
(CALL CONS 2)
(MOVEM O1 -5 Q)
(CALL NREVERSE 1)
(MOVEM O1 -3 Q)
(MOVE O1 -10 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 4))
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O1 -10 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 5))
(MOVE O2 0 Q)
(CALL LIST 3)
(MOVEM O1 -1 Q)
(MOVE O4 -9 Q)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -2 Q)
(MOVE O3 -1 Q)
(CALL LIST 4)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 7))
(MOVE O2 -3 Q)
(CALL LIST 3)
(JRST 8)
(LABEL 13) (MOVE O1 -7 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O1 -6 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -5 Q)
(CALL CONS 2)
(MOVEM O1 -5 Q)
(MOVE O1 -7 Q)
(MOVE O1 1 O1)
(MOVEM O1 -7 Q)
(MOVE O1 -6 Q)
(MOVE O1 1 O1)
(MOVEM O1 -6 Q)
(JRST 12)
(LABEL 8)
(LABEL 7)
(LABEL 5)
(LABEL 3) (SUBI Q 16)
(POPJ P)
)
(%PUT (QUOTE POP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (PLACE)))
(%PUT (QUOTE POP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE POP) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE INCF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The first argument is some location holding a number. This number is
incremented by the second argument, DELTA, which defaults to 1."))
#_(LAP #0_INCF MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(3 2 "Macro ~S cannot be called with ~S args." INCF 1 + LET*)
(CODE-START)
(LABEL 1) (ADDI Q 15)
(MOVEM O1 -14 Q)
(CALL LENGTH 1)
(MOVEM O1 -13 Q)
(MOVE O2 (CONSTANT 0))
(CALL > 2)
(JUMPN1 O1 5)
(MOVE O1 -14 Q)
(CALL LENGTH 1)
(MOVEM O1 -13 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O1 -14 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 -14 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -12 Q)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 8)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -11 Q)
(JRST 7)
(LABEL 8) (SKIPA)
(JRST 9)
(MOVE O5 (CONSTANT 4))
(MOVEM O5 -11 Q)
(LABEL 9)
(LABEL 7) (MOVE O1 -12 Q)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -10 Q)
(MOVEM O2 -9 Q)
(MOVEM O3 -8 Q)
(MOVEM O4 -7 Q)
(MOVEM O5 -6 Q)
(MOVE O5 O1)
(MOVEM O5 -5 Q)
(MOVE O5 O2)
(MOVEM O5 -4 Q)
(MOVEM NIL -3 Q)
(LABEL 15) (SKIPE NIL -5 Q)
(JRST 16)
(MOVE O1 -8 Q)
(MOVE O5 0 O1)
(MOVEM O5 -2 Q)
(MOVE O3 -11 Q)
(MOVE O1 (CONSTANT 5))
(MOVE O2 -6 Q)
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 -2 Q)
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O2 -3 Q)
(CALL CONS 2)
(MOVEM O1 -3 Q)
(CALL NREVERSE 1)
(MOVEM O1 -1 Q)
(MOVE O3 -7 Q)
(MOVE O1 (CONSTANT 6))
(MOVE O2 -1 Q)
(CALL LIST 3)
(JRST 11)
(LABEL 16) (MOVE O1 -5 Q)
(MOVE O5 1 O1)
(MOVEM O5 -2 Q)
(MOVE O1 -4 Q)
(MOVE O5 1 O1)
(MOVEM O5 -1 Q)
(MOVE O1 -5 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 -4 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(CALL CONS 2)
(MOVEM O1 0 Q)
(MOVE O1 -2 Q)
(MOVEM O1 -5 Q)
(MOVE O1 -1 Q)
(MOVEM O1 -4 Q)
(MOVE O1 0 Q)
(MOVEM O1 -3 Q)
(JRST 15)
(LABEL 11)
(LABEL 6)
(LABEL 3) (SUBI Q 15)
(POPJ P)
)
(%PUT (QUOTE INCF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&OPTIONAL (DELTA 1))))
(%PUT (QUOTE INCF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE INCF) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE DECF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The first argument is some location holding a number. This number is
decremented by the second argument, DELTA, which defaults to 1."))
#_(LAP #0_DECF MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(3 2 "Macro ~S cannot be called with ~S args." DECF 1 - LET*)
(CODE-START)
(LABEL 1) (ADDI Q 15)
(MOVEM O1 -14 Q)
(CALL LENGTH 1)
(MOVEM O1 -13 Q)
(MOVE O2 (CONSTANT 0))
(CALL > 2)
(JUMPN1 O1 5)
(MOVE O1 -14 Q)
(CALL LENGTH 1)
(MOVEM O1 -13 Q)
(MOVE O2 (CONSTANT 1))
(CALL < 2)
(SKIPN NIL O1)
(LABEL 5) (JRST 4)
(MOVE O1 -14 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 -14 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -12 Q)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(SKIPN NIL 1 O1)
(JRST 8)
(MOVE O1 -14 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -11 Q)
(JRST 7)
(LABEL 8) (SKIPA)
(JRST 9)
(MOVE O5 (CONSTANT 4))
(MOVEM O5 -11 Q)
(LABEL 9)
(LABEL 7) (MOVE O1 -12 Q)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -10 Q)
(MOVEM O2 -9 Q)
(MOVEM O3 -8 Q)
(MOVEM O4 -7 Q)
(MOVEM O5 -6 Q)
(MOVE O5 O1)
(MOVEM O5 -5 Q)
(MOVE O5 O2)
(MOVEM O5 -4 Q)
(MOVEM NIL -3 Q)
(LABEL 15) (SKIPE NIL -5 Q)
(JRST 16)
(MOVE O1 -8 Q)
(MOVE O5 0 O1)
(MOVEM O5 -2 Q)
(MOVE O3 -11 Q)
(MOVE O1 (CONSTANT 5))
(MOVE O2 -6 Q)
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 -2 Q)
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O2 -3 Q)
(CALL CONS 2)
(MOVEM O1 -3 Q)
(CALL NREVERSE 1)
(MOVEM O1 -1 Q)
(MOVE O3 -7 Q)
(MOVE O1 (CONSTANT 6))
(MOVE O2 -1 Q)
(CALL LIST 3)
(JRST 11)
(LABEL 16) (MOVE O1 -5 Q)
(MOVE O5 1 O1)
(MOVEM O5 -2 Q)
(MOVE O1 -4 Q)
(MOVE O5 1 O1)
(MOVEM O5 -1 Q)
(MOVE O1 -5 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O1 -4 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 0 Q)
(MOVE O2 -3 Q)
(CALL CONS 2)
(MOVEM O1 0 Q)
(MOVE O1 -2 Q)
(MOVEM O1 -5 Q)
(MOVE O1 -1 Q)
(MOVEM O1 -4 Q)
(MOVE O1 0 Q)
(MOVEM O1 -3 Q)
(JRST 15)
(LABEL 11)
(LABEL 6)
(LABEL 3) (SUBI Q 15)
(POPJ P)
)
(%PUT (QUOTE DECF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&OPTIONAL (DELTA 1))))
(%PUT (QUOTE DECF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE DECF) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE PUTF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Place may be any place expression acceptable to SETF, and is expected
to hold a property list or (). This list is destructively altered so
that (GETF place indicator) will find the specified newvalue. Returns
the new value."))
#_(LAP #0_PUTF MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(4 "Macro ~S cannot be called with ~S args." PUTF LET* SETQ %SP-PUTF)
(CODE-START)
(LABEL 1) (ADDI Q 20)
(MOVEM O1 -19 Q)
(CALL LENGTH 1)
(MOVEM O1 -18 Q)
(MOVE O2 (CONSTANT 0))
(CALL = 2)
(JUMPN O1 4)
(MOVE O1 -19 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 -19 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -17 Q)
(MOVE O1 -19 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -16 Q)
(MOVE O1 -19 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -15 Q)
(MOVE O1 -17 Q)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -14 Q)
(MOVEM O2 -13 Q)
(MOVEM O3 -12 Q)
(MOVEM O4 -11 Q)
(MOVEM O5 -10 Q)
(MOVE O5 O1)
(MOVEM O5 -9 Q)
(MOVE O5 O2)
(MOVEM O5 -8 Q)
(MOVEM NIL -7 Q)
(CALL GENSYM 0)
(MOVEM O1 -6 Q)
(CALL GENSYM 0)
(MOVEM O1 -5 Q)
(LABEL 10) (SKIPE NIL -9 Q)
(JRST 11)
(MOVE O1 -12 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O2 -10 Q)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -7 Q)
(CALL CONS 2)
(MOVEM O1 -7 Q)
(MOVE O2 -16 Q)
(MOVE O1 -6 Q)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -7 Q)
(CALL CONS 2)
(MOVEM O1 -7 Q)
(MOVE O2 -15 Q)
(MOVE O1 -5 Q)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -7 Q)
(CALL CONS 2)
(MOVEM O1 -7 Q)
(CALL NREVERSE 1)
(MOVEM O1 -3 Q)
(MOVE O1 -12 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O4 -5 Q)
(MOVE O1 (CONSTANT 5))
(MOVE O2 O5)
(MOVE O3 -6 Q)
(CALL LIST 4)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -1 Q)
(CALL LIST 3)
(MOVEM O1 -2 Q)
(MOVE O5 -5 Q)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -3 Q)
(MOVE O3 -2 Q)
(MOVE O4 -11 Q)
(CALL LIST 5)
(JRST 6)
(LABEL 11) (MOVE O1 -9 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O1 -8 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O2 -7 Q)
(CALL CONS 2)
(MOVEM O1 -7 Q)
(MOVE O1 -9 Q)
(MOVE O1 1 O1)
(MOVEM O1 -9 Q)
(MOVE O1 -8 Q)
(MOVE O1 1 O1)
(MOVEM O1 -8 Q)
(JRST 10)
(LABEL 6)
(LABEL 5)
(LABEL 3) (SUBI Q 20)
(POPJ P)
)
(%PUT (QUOTE PUTF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (PLACE INDICATOR VALUE)))
(%PUT (QUOTE PUTF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE PUTF) (QUOTE %SOURCE-DOCUMENTATION))))
#_(LAP #0_%SP-PUTF EXPR
(ENTRY-POINTS (2-FEW 2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY))
#0_("Odd length property list in PUTF")
(CODE-START)
(LABEL 1) (ADDI Q 5)
(MOVEM O1 -4 Q)
(MOVEM O2 -3 Q)
(MOVEM O3 -2 Q)
(MOVE O5 O1)
(MOVEM O5 -1 Q)
(LABEL 7) (MOVE O1 -1 Q)
(CALL ATOM 1)
(JUMPE O1 8)
(MOVE O3 -4 Q)
(MOVE O1 -3 Q)
(MOVE O2 -2 Q)
(CALL LIST* 3)
(JRST 3)
(LABEL 8) (MOVE O1 -1 Q)
(MOVE O1 1 O1)
(CALL ATOM 1)
(JUMPE O1 11)
(MOVE O1 (CONSTANT 0))
(CALL ERROR 1)
(JRST 10)
(LABEL 11) (MOVE O1 -1 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 -3 Q)
(CAME O2 0 Q)
(JRST 12)
(MOVE O5 1 O1)
(MOVEM O5 0 Q)
(MOVE O2 -2 Q)
(MOVE O1 O5)
(CALL RPLACA 2)
(MOVE O1 -4 Q)
(MOVEI N 1)
(JRST 3)
(LABEL 12)
(LABEL 10) (MOVE O1 -1 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVEM O1 -1 Q)
(JRST 7)
(LABEL 3) (SUBI Q 5)
(POPJ P)
)
(%PUT (QUOTE %SP-PUTF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (PLACE INDICATOR VALUE)))
(%PUT (QUOTE %SP-PUTF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE %SP-PUTF) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE REMF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Place may be any place expression acceptable to SETF, and is expected
to hold a property list or (). This list is destructively altered to
remove the property specified by the indicator. Returns T if such a
property was present, NIL if not."))
#_(LAP #0_REMF 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." REMF LET* DO CDDR ATOM (NIL) COND CDR ((ERROR "Odd-length property list in REMF.")) EQ CAR RPLACD ((RETURN T)) T SETQ)
(CODE-START)
(LABEL 1) (ADDI Q 26)
(MOVEM O1 -25 Q)
(CALL LENGTH 1)
(MOVEM O1 -24 Q)
(MOVE O2 (CONSTANT 0))
(CALL = 2)
(JUMPN O1 4)
(MOVE O1 -25 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 -25 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -23 Q)
(MOVE O1 -25 Q)
(MOVE O1 1 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -22 Q)
(MOVE O1 -23 Q)
(CALL GET-SETF-METHOD 1)
(ADJUST-VALUES 5)
(MOVEM O1 -21 Q)
(MOVEM O2 -20 Q)
(MOVEM O3 -19 Q)
(MOVEM O4 -18 Q)
(MOVEM O5 -17 Q)
(MOVE O5 O1)
(MOVEM O5 -16 Q)
(MOVE O5 O2)
(MOVEM O5 -15 Q)
(MOVEM NIL -14 Q)
(CALL GENSYM 0)
(MOVEM O1 -13 Q)
(CALL GENSYM 0)
(MOVEM O1 -12 Q)
(CALL GENSYM 0)
(MOVEM O1 -11 Q)
(LABEL 10) (SKIPE NIL -16 Q)
(JRST 11)
(MOVE O1 -19 Q)
(MOVE O5 0 O1)
(MOVEM O5 -10 Q)
(MOVE O2 -17 Q)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -10 Q)
(MOVE O2 -14 Q)
(CALL CONS 2)
(MOVEM O1 -14 Q)
(MOVE O2 -22 Q)
(MOVE O1 -13 Q)
(CALL LIST 2)
(MOVEM O1 -10 Q)
(MOVE O2 -14 Q)
(CALL CONS 2)
(MOVEM O1 -14 Q)
(CALL NREVERSE 1)
(MOVEM O1 -9 Q)
(MOVE O1 -19 Q)
(MOVE O5 0 O1)
(MOVEM O5 -7 Q)
(MOVE O2 -12 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 -12 Q)
(MOVE O2 -7 Q)
(CALL LIST 3)
(MOVEM O1 -8 Q)
(MOVE O3 -12 Q)
(MOVE O1 -11 Q)
(MOVE O2 NIL)
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 -8 Q)
(CALL LIST 2)
(MOVEM O1 -8 Q)
(MOVE O2 -12 Q)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -7 Q)
(MOVE O2 (CONSTANT 7))
(CALL CONS 2)
(MOVEM O1 -7 Q)
(MOVE O2 -12 Q)
(MOVE O1 (CONSTANT 9))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 6))
(CALL LIST 2)
(MOVEM O1 -6 Q)
(MOVE O2 (CONSTANT 10))
(CALL CONS 2)
(MOVEM O1 -6 Q)
(MOVE O2 -12 Q)
(MOVE O1 (CONSTANT 12))
(CALL LIST 2)
(MOVEM O1 -4 Q)
(MOVE O3 -13 Q)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -4 Q)
(CALL LIST 3)
(MOVEM O1 -5 Q)
(MOVE O2 -11 Q)
(MOVE O1 (CONSTANT 9))
(CALL LIST 2)
(MOVEM O1 -1 Q)
(MOVE O2 -12 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 13))
(MOVE O2 -1 Q)
(CALL LIST 3)
(MOVEM O1 -2 Q)
(MOVE O3 (CONSTANT 14))
(MOVE O1 -11 Q)
(MOVE O2 -2 Q)
(CALL LIST* 3)
(MOVEM O1 -3 Q)
(MOVE O1 -19 Q)
(MOVE O5 0 O1)
(MOVEM O5 0 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 16))
(MOVE O2 0 Q)
(CALL LIST 3)
(MOVEM O1 -1 Q)
(MOVE O4 (CONSTANT 14))
(MOVE O1 (CONSTANT 15))
(MOVE O2 -1 Q)
(MOVE O3 -18 Q)
(CALL LIST* 4)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -3 Q)
(CALL LIST 3)
(MOVE O2 O1)
(MOVE O1 -5 Q)
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -6 Q)
(CALL LIST 3)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -8 Q)
(MOVE O3 -7 Q)
(CALL LIST 4)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -9 Q)
(CALL LIST 3)
(JRST 6)
(LABEL 11) (MOVE O1 -16 Q)
(MOVE O5 0 O1)
(MOVEM O5 -10 Q)
(MOVE O1 -15 Q)
(MOVE O2 0 O1)
(MOVE O1 O5)
(CALL LIST 2)
(MOVEM O1 -10 Q)
(MOVE O2 -14 Q)
(CALL CONS 2)
(MOVEM O1 -14 Q)
(MOVE O1 -16 Q)
(MOVE O1 1 O1)
(MOVEM O1 -16 Q)
(MOVE O1 -15 Q)
(MOVE O1 1 O1)
(MOVEM O1 -15 Q)
(JRST 10)
(LABEL 6)
(LABEL 5)
(LABEL 3) (SUBI Q 26)
(POPJ P)
)
(%PUT (QUOTE REMF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (PLACE INDICATOR)))
(%PUT (QUOTE REMF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE REMF) (QUOTE %SOURCE-DOCUMENTATION))))
(REMPROP (QUOTE CAR) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE CAR) (QUOTE SETF-INVERSE) (QUOTE %RPLACA))
(QUOTE CAR)
(REMPROP (QUOTE CDR) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE CDR) (QUOTE SETF-INVERSE) (QUOTE %RPLACD))
(QUOTE CDR)
(REMPROP (QUOTE CAAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CAAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CAAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CAAR)
(REMPROP (QUOTE CADR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CADR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CADR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CADR)
(REMPROP (QUOTE CDAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDAR)
(REMPROP (QUOTE CDDR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDDR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDDR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDDR)
(REMPROP (QUOTE CAAAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CAAAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CAAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CAAAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CAAAR)
(REMPROP (QUOTE CADAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CADAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CADAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CADAR)
(REMPROP (QUOTE CDAAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDAAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CAAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDAAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDAAR)
(REMPROP (QUOTE CDDAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDDAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CDAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDDAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDDAR)
(REMPROP (QUOTE CAADR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CAADR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CADR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CAADR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CAADR)
(REMPROP (QUOTE CADDR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CADDR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CADDR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CADDR)
(REMPROP (QUOTE CDADR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDADR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CADR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDADR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDADR)
(REMPROP (QUOTE CDDDR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDDDR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CDDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDDDR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDDDR)
(REMPROP (QUOTE CAAAAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CAAAAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CAAAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CAAAAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CAAAAR)
(REMPROP (QUOTE CADAAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CADAAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDAAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CADAAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CADAAR)
(REMPROP (QUOTE CDAAAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDAAAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CAAAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDAAAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDAAAR)
(REMPROP (QUOTE CDDAAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDDAAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CDAAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDDAAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDDAAR)
(REMPROP (QUOTE CAADAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CAADAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CADAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CAADAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CAADAR)
(REMPROP (QUOTE CADDAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CADDAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CADDAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CADDAR)
(REMPROP (QUOTE CDADAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDADAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CADAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDADAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDADAR)
(REMPROP (QUOTE CDDDAR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDDDAR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CDDAR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDDDAR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDDDAR)
(REMPROP (QUOTE CAAADR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CAAADR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CAADR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CAAADR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CAAADR)
(REMPROP (QUOTE CADADR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CADADR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDADR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CADADR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CADADR)
(REMPROP (QUOTE CDAADR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDAADR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CAADR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDAADR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDAADR)
(REMPROP (QUOTE CDDADR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDDADR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CDADR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDDADR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDDADR)
(REMPROP (QUOTE CAADDR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CAADDR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CADDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CAADDR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CAADDR)
(REMPROP (QUOTE CADDDR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CADDDR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CADDDR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CADDDR)
(REMPROP (QUOTE CDADDR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDADDR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CADDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDADDR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDADDR)
(REMPROP (QUOTE CDDDDR) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CDDDDR) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACD) (LIST (QUOTE CDDDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE CDDDDR) (QUOTE %SETF-DOCUMENTATION))
(QUOTE CDDDDR)
(REMPROP (QUOTE FIRST) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE FIRST) (QUOTE SETF-INVERSE) (QUOTE %RPLACA))
(QUOTE FIRST)
(REMPROP (QUOTE SECOND) (QUOTE SETF-INVERSE))
(%PUT (QUOTE SECOND) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE SECOND) (QUOTE %SETF-DOCUMENTATION))
(QUOTE SECOND)
(REMPROP (QUOTE THIRD) (QUOTE SETF-INVERSE))
(%PUT (QUOTE THIRD) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE THIRD) (QUOTE %SETF-DOCUMENTATION))
(QUOTE THIRD)
(REMPROP (QUOTE FOURTH) (QUOTE SETF-INVERSE))
(%PUT (QUOTE FOURTH) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE FOURTH) (QUOTE %SETF-DOCUMENTATION))
(QUOTE FOURTH)
(REMPROP (QUOTE FIFTH) (QUOTE SETF-INVERSE))
(%PUT (QUOTE FIFTH) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDDDR) X) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE FIFTH) (QUOTE %SETF-DOCUMENTATION))
(QUOTE FIFTH)
(REMPROP (QUOTE SIXTH) (QUOTE SETF-INVERSE))
(%PUT (QUOTE SIXTH) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDR) (LIST (QUOTE CDDDDR) X)) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE SIXTH) (QUOTE %SETF-DOCUMENTATION))
(QUOTE SIXTH)
(REMPROP (QUOTE SEVENTH) (QUOTE SETF-INVERSE))
(%PUT (QUOTE SEVENTH) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDR) (LIST (QUOTE CDDDDR) X)) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE SEVENTH) (QUOTE %SETF-DOCUMENTATION))
(QUOTE SEVENTH)
(REMPROP (QUOTE EIGHTH) (QUOTE SETF-INVERSE))
(%PUT (QUOTE EIGHTH) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDDR) (LIST (QUOTE CDDDDR) X)) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE EIGHTH) (QUOTE %SETF-DOCUMENTATION))
(QUOTE EIGHTH)
(REMPROP (QUOTE NINTH) (QUOTE SETF-INVERSE))
(%PUT (QUOTE NINTH) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDDDDR) (LIST (QUOTE CDDDDR) X)) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE NINTH) (QUOTE %SETF-DOCUMENTATION))
(QUOTE NINTH)
(REMPROP (QUOTE TENTH) (QUOTE SETF-INVERSE))
(%PUT (QUOTE TENTH) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((X (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE %RPLACA) (LIST (QUOTE CDR) (LIST (QUOTE CDDDDR) (LIST (QUOTE CDDDDR) X))) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE TENTH) (QUOTE %SETF-DOCUMENTATION))
(QUOTE TENTH)
(REMPROP (QUOTE REST) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE REST) (QUOTE SETF-INVERSE) (QUOTE %RPLACD))
(QUOTE REST)
(REMPROP (QUOTE ELT) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE ELT) (QUOTE SETF-INVERSE) (QUOTE %SETELT))
(QUOTE ELT)
(REMPROP (QUOTE AREF) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE AREF) (QUOTE SETF-INVERSE) (QUOTE %ASET))
(QUOTE AREF)
(REMPROP (QUOTE SVREF) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE SVREF) (QUOTE SETF-INVERSE) (QUOTE %SVSET))
(QUOTE SVREF)
(REMPROP (QUOTE CHAR) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE CHAR) (QUOTE SETF-INVERSE) (QUOTE %CHARSET))
(QUOTE CHAR)
(REMPROP (QUOTE BIT) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE BIT) (QUOTE SETF-INVERSE) (QUOTE %BITSET))
(QUOTE BIT)
(REMPROP (QUOTE SCHAR) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE SCHAR) (QUOTE SETF-INVERSE) (QUOTE %SCHARSET))
(QUOTE SCHAR)
(REMPROP (QUOTE SBIT) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE SBIT) (QUOTE SETF-INVERSE) (QUOTE %SBITSET))
(QUOTE SBIT)
(REMPROP (QUOTE SYMBOL-VALUE) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE SYMBOL-VALUE) (QUOTE SETF-INVERSE) (QUOTE SET))
(QUOTE SYMBOL-VALUE)
(REMPROP (QUOTE SYMBOL-FUNCTION) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE SYMBOL-FUNCTION) (QUOTE SETF-INVERSE) (QUOTE %SP-SET-DEFINITION))
(QUOTE SYMBOL-FUNCTION)
(REMPROP (QUOTE SYMBOL-PLIST) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE SYMBOL-PLIST) (QUOTE SETF-INVERSE) (QUOTE %SET-PLIST))
(QUOTE SYMBOL-PLIST)
(REMPROP (QUOTE DOCUMENTATION) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE DOCUMENTATION) (QUOTE SETF-INVERSE) (QUOTE %SET-DOCUMENTATION))
(QUOTE DOCUMENTATION)
(REMPROP (QUOTE NTH) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE NTH) (QUOTE SETF-INVERSE) (QUOTE %SETNTH))
(QUOTE NTH)
(REMPROP (QUOTE %SP-SVREF) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE %SP-SVREF) (QUOTE SETF-INVERSE) (QUOTE %SP-SVSET))
(QUOTE %SP-SVREF)
(REMPROP (QUOTE %SP-SCHAR) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE %SP-SCHAR) (QUOTE SETF-INVERSE) (QUOTE %SP-SCHARSET))
(QUOTE %SP-SCHAR)
(REMPROP (QUOTE %SP-SBIT) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE %SP-SBIT) (QUOTE SETF-INVERSE) (QUOTE %SP-SBITSET))
(QUOTE %SP-SBIT)
(REMPROP (QUOTE %SP-SAREF1) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE %SP-SAREF1) (QUOTE SETF-INVERSE) (QUOTE %SP-SASET1))
(QUOTE %SP-SAREF1)
(REMPROP (QUOTE %SP-CVREF) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE %SP-CVREF) (QUOTE SETF-INVERSE) (QUOTE %SP-CVSET))
(QUOTE %SP-CVREF)
(REMPROP (QUOTE %SP-CCHAR) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE %SP-CCHAR) (QUOTE SETF-INVERSE) (QUOTE %SP-CCHARSET))
(QUOTE %SP-CCHAR)
(REMPROP (QUOTE %SP-CBIT) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE %SP-CBIT) (QUOTE SETF-INVERSE) (QUOTE %SP-CBITSET))
(QUOTE %SP-CBIT)
(REMPROP (QUOTE %SP-CAREF1) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE %SP-CAREF1) (QUOTE SETF-INVERSE) (QUOTE %SP-CASET1))
(QUOTE %SP-CAREF1)
(REMPROP (QUOTE FILL-POINTER) (QUOTE SETF-METHOD-EXPANDER))
(%PUT (QUOTE FILL-POINTER) (QUOTE SETF-INVERSE) (QUOTE %SET-FILL-POINTER))
(QUOTE FILL-POINTER)
(REMPROP (QUOTE GETF) (QUOTE SETF-INVERSE))
(%PUT (QUOTE GETF) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (%LAMBDA-LIST) (COND ((OR (> (LENGTH %LAMBDA-LIST) 4) (< (LENGTH %LAMBDA-LIST) 3)) (ERROR "Setf expander for ~S cannot be called with ~S args." (QUOTE GETF) (1- (LENGTH %LAMBDA-LIST)))) (T (LET* ((PLACE (CAR (CDR %LAMBDA-LIST))) (PROP (CAR (CDR (CDR %LAMBDA-LIST)))) (DEFAULT (COND ((CDR (CDR (CDR %LAMBDA-LIST))) (CAR (CDR (CDR (CDR %LAMBDA-LIST))))) (T NIL)))) (MULTIPLE-VALUE-BIND (TEMPS VALUES STORES SET GET) (GET-SETF-METHOD PLACE) (LET ((NEWVAL (GENSYM)) (PTEMP (GENSYM)) (DEF-TEMP (GENSYM))) (VALUES (APPEND TEMPS (LIST* (CAR STORES) PTEMP (IF DEFAULT (LIST DEF-TEMP)))) (APPEND VALUES (LIST* GET PROP (IF DEFAULT (LIST DEFAULT)))) (LIST NEWVAL) (LIST (QUOTE PROGN) (LIST (QUOTE SETQ) (CAR STORES) (LIST (QUOTE %SP-PUTF) (CAR STORES) PTEMP NEWVAL)) SET NEWVAL) (LIST* (QUOTE GETF) (CAR STORES) PTEMP (IF DEFAULT (LIST DEF-TEMP))))))))))))
(QUOTE GETF)
(REMPROP (QUOTE GET) (QUOTE SETF-INVERSE))
(%PUT (QUOTE GET) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (%LAMBDA-LIST) (COND ((OR (> (LENGTH %LAMBDA-LIST) 4) (< (LENGTH %LAMBDA-LIST) 3)) (ERROR "Setf expander for ~S cannot be called with ~S args." (QUOTE GET) (1- (LENGTH %LAMBDA-LIST)))) (T (LET* ((SYMBOL (CAR (CDR %LAMBDA-LIST))) (PROP (CAR (CDR (CDR %LAMBDA-LIST)))) (DEFAULT (COND ((CDR (CDR (CDR %LAMBDA-LIST))) (CAR (CDR (CDR (CDR %LAMBDA-LIST))))) (T NIL)))) (LET ((SYMBOL-TEMP (GENSYM)) (PROP-TEMP (GENSYM)) (DEF-TEMP (GENSYM)) (NEWVAL (GENSYM))) (VALUES (LIST* SYMBOL-TEMP PROP-TEMP (IF DEFAULT (LIST DEF-TEMP))) (LIST* SYMBOL PROP (IF DEFAULT (LIST DEFAULT))) (LIST NEWVAL) (LIST (QUOTE %PUT) SYMBOL-TEMP PROP-TEMP NEWVAL) (LIST* (QUOTE GET) SYMBOL-TEMP PROP-TEMP (IF DEFAULT (LIST DEF-TEMP)))))))))))
(%PUT (QUOTE GET) (QUOTE %SETF-DOCUMENTATION) (QUOTE "Get turns into %put. Don't put in the default unless it really is
supplied and non-nil, so that we can transform into the get
instruction whenever possible."))
(QUOTE GET)
(REMPROP (QUOTE MACRO-FUNCTION) (QUOTE SETF-INVERSE))
(%PUT (QUOTE MACRO-FUNCTION) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST DEF) (LET* ((SYMBOL (CAR (CDR %ACCESS-ARGLIST)))) (LIST (QUOTE CDR) (LIST (QUOTE %SP-SET-DEFINITION) SYMBOL (LIST (QUOTE CONS) (QUOTE (QUOTE MACRO)) DEF)))))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE MACRO-FUNCTION) (QUOTE %SETF-DOCUMENTATION))
(QUOTE MACRO-FUNCTION)
(REMPROP (QUOTE GETHASH) (QUOTE SETF-INVERSE))
(%PUT (QUOTE GETHASH) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (%LAMBDA-LIST) (COND ((OR (> (LENGTH %LAMBDA-LIST) 4) (< (LENGTH %LAMBDA-LIST) 3)) (ERROR "Setf expander for ~S cannot be called with ~S args." (QUOTE GETHASH) (1- (LENGTH %LAMBDA-LIST)))) (T (LET* ((KEY (CAR (CDR %LAMBDA-LIST))) (HASHTABLE (CAR (CDR (CDR %LAMBDA-LIST)))) (DEFAULT (COND ((CDR (CDR (CDR %LAMBDA-LIST))) (CAR (CDR (CDR (CDR %LAMBDA-LIST))))) (T NIL)))) (LET ((KEY-TEMP (GENSYM)) (HASHTABLE-TEMP (GENSYM)) (DEFAULT-TEMP (GENSYM)) (NEW-VALUE-TEMP (GENSYM))) (VALUES (LIST* KEY-TEMP HASHTABLE-TEMP (IF DEFAULT (LIST DEFAULT-TEMP))) (LIST* KEY HASHTABLE (IF DEFAULT (LIST DEFAULT))) (LIST NEW-VALUE-TEMP) (LIST (QUOTE %PUTHASH) KEY-TEMP HASHTABLE-TEMP NEW-VALUE-TEMP) (LIST* (QUOTE GETHASH) KEY-TEMP HASHTABLE-TEMP (IF DEFAULT (LIST DEFAULT-TEMP)))))))))))
(QUOTE GETHASH)
(REMPROP (QUOTE SUBSEQ) (QUOTE SETF-INVERSE))
(%PUT (QUOTE SUBSEQ) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (ACCESS-FORM) (DO* ((ARGS (CDR ACCESS-FORM) (CDR ARGS)) (DUMMIES NIL (CONS (GENSYM) DUMMIES)) (NEWVAL-VAR (GENSYM)) (NEW-ACCESS-FORM NIL)) ((ATOM ARGS) (SETQ NEW-ACCESS-FORM (CONS (CAR ACCESS-FORM) DUMMIES)) (VALUES DUMMIES (CDR ACCESS-FORM) (LIST NEWVAL-VAR) (FUNCALL (FUNCTION (LAMBDA (%ACCESS-ARGLIST V) (LET* ((SEQUENCE (CAR (CDR %ACCESS-ARGLIST))) (START (CAR (CDR (CDR %ACCESS-ARGLIST)))) (END (COND ((CDR (CDR (CDR %ACCESS-ARGLIST))) (CAR (CDR (CDR (CDR %ACCESS-ARGLIST))))) (T NIL)))) (LIST (QUOTE PROGN) (LIST (QUOTE REPLACE) SEQUENCE V (QUOTE :START1) START (QUOTE :END1) END) V)))) NEW-ACCESS-FORM NEWVAL-VAR) NEW-ACCESS-FORM))))))
(REMPROP (QUOTE SUBSEQ) (QUOTE %SETF-DOCUMENTATION))
(QUOTE SUBSEQ)
(REMPROP (QUOTE APPLY) (QUOTE SETF-INVERSE))
(%PUT (QUOTE APPLY) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (%LAMBDA-LIST) (COND ((< (LENGTH %LAMBDA-LIST) 2) (ERROR "Setf expander for ~S cannot be called with ~S args." (QUOTE APPLY) (1- (LENGTH %LAMBDA-LIST)))) (T (LET* ((FUNCTION (CAR (CDR %LAMBDA-LIST))) (ARGS (CDR (CDR %LAMBDA-LIST)))) (IF (AND (LISTP FUNCTION) (= (LIST-LENGTH FUNCTION) 2) (EQ (CAR FUNCTION) (QUOTE FUNCTION)) (SYMBOLP (SECOND FUNCTION))) (SETQ FUNCTION (SECOND FUNCTION)) (ERROR "Setf of Apply is only defined for function args of form #'symbol.")) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) (GET-SETF-METHOD (CONS FUNCTION ARGS)) (COND ((AND (EQ (CAR (LAST ARGS)) (CAR (LAST VALS))) (EQ (CAR (LAST GETTER)) (CAR (LAST DUMMIES))) (EQ (CAR (LAST SETTER)) (CAR (LAST DUMMIES)))) (VALUES DUMMIES VALS NEWVAL (LIST* (QUOTE APPLY) (LIST (QUOTE FUNCTION) (CAR SETTER)) (CDR SETTER)) (LIST* (QUOTE APPLY) (LIST (QUOTE FUNCTION) (CAR GETTER)) (CDR SETTER)))) ((AND (EQ (CAR (LAST ARGS)) (CAR (LAST VALS))) (EQ (CAR (LAST GETTER)) (CAR (LAST DUMMIES))) (EQ (PENULT SETTER) (CAR (LAST DUMMIES)))) (VALUES DUMMIES VALS NEWVAL (LIST* (QUOTE APPLY-BUT-LAST) (LIST (QUOTE FUNCTION) (CAR SETTER)) (CDR SETTER)) (LIST* (QUOTE APPLY) (LIST (QUOTE FUNCTION) (CAR GETTER)) (CDR SETTER)))) (T (ERROR "Apply of ~S not understood as a location for Setf." FUNCTION))))))))))
(QUOTE APPLY)
#_(LAP #0_PENULT EXPR
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_NIL
(CODE-START)
(LABEL 1) (ADDI Q 1)
(MOVEM O1 0 Q)
(MOVE O1 1 O1)
(SKIPE NIL 1 O1)
(JRST 3)
(MOVE O1 0 Q)
(MOVE O1 0 O1)
(MOVEI N 1)
(JRST 4)
(LABEL 3) (MOVE O1 0 Q)
(MOVE O1 1 O1)
(CALL LISP::PENULT 1)
(LABEL 4) (SUBI Q 1)
(POPJ P)
)
(%PUT (QUOTE PENULT) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (X)))
(%PUT (QUOTE PENULT) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE PENULT) (QUOTE %SOURCE-DOCUMENTATION))))
(REMPROP (QUOTE LDB) (QUOTE SETF-INVERSE))
(%PUT (QUOTE LDB) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (%LAMBDA-LIST) (COND ((NOT (= (LENGTH %LAMBDA-LIST) 3)) (ERROR "Setf expander for ~S cannot be called with ~S args." (QUOTE LDB) (1- (LENGTH %LAMBDA-LIST)))) (T (LET* ((BYTESPEC (CAR (CDR %LAMBDA-LIST))) (PLACE (CAR (CDR (CDR %LAMBDA-LIST))))) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) (GET-SETF-METHOD PLACE) (LET ((BTEMP (GENSYM)) (GNUVAL (GENSYM))) (VALUES (CONS BTEMP DUMMIES) (CONS BYTESPEC VALS) (LIST GNUVAL) (LIST (QUOTE LET) (LIST (LIST (CAR NEWVAL) (LIST (QUOTE DPB) GNUVAL BTEMP GETTER))) SETTER GNUVAL) (LIST (QUOTE LDB) BTEMP GETTER))))))))))
(%PUT (QUOTE LDB) (QUOTE %SETF-DOCUMENTATION) (QUOTE "The first argument is a byte specifier. The second is any place form
acceptable to SETF. Replaces the specified byte of the number in this
place with bits from the low-order end of the new value."))
(QUOTE LDB)
(REMPROP (QUOTE MASK-FIELD) (QUOTE SETF-INVERSE))
(%PUT (QUOTE MASK-FIELD) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (%LAMBDA-LIST) (COND ((NOT (= (LENGTH %LAMBDA-LIST) 3)) (ERROR "Setf expander for ~S cannot be called with ~S args." (QUOTE MASK-FIELD) (1- (LENGTH %LAMBDA-LIST)))) (T (LET* ((BYTESPEC (CAR (CDR %LAMBDA-LIST))) (PLACE (CAR (CDR (CDR %LAMBDA-LIST))))) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) (GET-SETF-METHOD PLACE) (LET ((BTEMP (GENSYM)) (GNUVAL (GENSYM))) (VALUES (CONS BTEMP DUMMIES) (CONS BYTESPEC VALS) (LIST GNUVAL) (LIST (QUOTE LET) (LIST (LIST (CAR NEWVAL) (LIST (QUOTE DEPOSIT-FIELD) GNUVAL BTEMP GETTER))) SETTER GNUVAL) (LIST (QUOTE MASK-FIELD) BTEMP GETTER))))))))))
(%PUT (QUOTE MASK-FIELD) (QUOTE %SETF-DOCUMENTATION) (QUOTE "The first argument is a byte specifier. The second is any place form
acceptable to SETF. Replaces the specified byte of the number in this place
with bits from the corresponding position in the new value."))
(QUOTE MASK-FIELD)
(REMPROP (QUOTE CHAR-BIT) (QUOTE SETF-INVERSE))
(%PUT (QUOTE CHAR-BIT) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (%LAMBDA-LIST) (COND ((NOT (= (LENGTH %LAMBDA-LIST) 3)) (ERROR "Setf expander for ~S cannot be called with ~S args." (QUOTE CHAR-BIT) (1- (LENGTH %LAMBDA-LIST)))) (T (LET* ((PLACE (CAR (CDR %LAMBDA-LIST))) (BIT-NAME (CAR (CDR (CDR %LAMBDA-LIST))))) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) (GET-SETF-METHOD PLACE) (LET ((BTEMP (GENSYM)) (GNUVAL (GENSYM))) (VALUES (APPEND DUMMIES (LIST BTEMP)) (APPEND VALS (LIST BIT-NAME)) (LIST GNUVAL) (LIST (QUOTE LET) (LIST (LIST (CAR NEWVAL) (LIST (QUOTE SET-CHAR-BIT) GETTER BTEMP GNUVAL))) SETTER GNUVAL) (LIST (QUOTE CHAR-BIT) GETTER BTEMP))))))))))
(%PUT (QUOTE CHAR-BIT) (QUOTE %SETF-DOCUMENTATION) (QUOTE "The first argument is any place form acceptable to SETF. Replaces the
specified bit of the character in this place with the new value."))
(QUOTE CHAR-BIT)
(REMPROP (QUOTE THE) (QUOTE SETF-INVERSE))
(%PUT (QUOTE THE) (QUOTE SETF-METHOD-EXPANDER) (FUNCTION (LAMBDA (%LAMBDA-LIST) (COND ((NOT (= (LENGTH %LAMBDA-LIST) 3)) (ERROR "Setf expander for ~S cannot be called with ~S args." (QUOTE THE) (1- (LENGTH %LAMBDA-LIST)))) (T (LET* ((TYPE (CAR (CDR %LAMBDA-LIST))) (PLACE (CAR (CDR (CDR %LAMBDA-LIST))))) (MULTIPLE-VALUE-BIND (DUMMIES VALS NEWVAL SETTER GETTER) (GET-SETF-METHOD PLACE) (VALUES DUMMIES VALS NEWVAL (SUBST (LIST (QUOTE THE) TYPE (CAR NEWVAL)) (CAR NEWVAL) SETTER) (LIST (QUOTE THE) TYPE GETTER)))))))))
(QUOTE THE)
#_(LAP #0_CASE-BODY EXPR
(ENTRY-POINTS (2-FEW 2-FEW 2-FEW 2-FEW 2-FEW 2-FEW 2-FEW 1 2-MANY))
#0_("~S -- Bad clause in ~S." (T OTHERWISE) "No default clause allowed in ~S: ~S" T MEMBER QUOTE :TEST FUNCTION LET BLOCK TAGBODY RETURN-FROM COND CERROR PROCEED-STRING ERROR-STRING (WRITE-STRING "Expression for new key value: " *QUERY-IO*) SETQ SETF ((EVAL (READ *QUERY-IO*))) GO ERROR)
(CODE-START)
(LABEL 1) (ADDI Q 17)
(MOVEM O1 -16 Q)
(MOVEM O2 -15 Q)
(MOVEM O3 -14 Q)
(MOVEM O4 -13 Q)
(MOVEM O5 -12 Q)
(CALL GENSYM 0)
(MOVEM O1 -11 Q)
(CALL GENSYM 0)
(MOVEM O1 -10 Q)
(CALL GENSYM 0)
(MOVEM O1 -9 Q)
(MOVEM NIL -8 Q)
(MOVEM NIL -7 Q)
(MOVE O5 -14 Q)
(MOVEM O5 -6 Q)
(MOVE O1 O5)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(LABEL 7) (MOVE O1 -6 Q)
(CALL ATOM 1)
(JUMPE O1 8)
(JRST 3)
(LABEL 8) (MOVE O1 -5 Q)
(CALL ATOM 1)
(JUMPE O1 11)
(MOVE O3 -16 Q)
(MOVE O1 (CONSTANT 0))
(MOVE O2 -5 Q)
(CALL ERROR 3)
(JRST 10)
(LABEL 11) (MOVE O1 -5 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O2 (CONSTANT 1))
(MOVE O1 O5)
(CALL MEMQ 2)
(JUMPE O1 12)
(SKIPN NIL -18 Q)
(JRST 13)
(MOVE O3 -5 Q)
(MOVE O1 (CONSTANT 2))
(MOVE O2 -16 Q)
(CALL ERROR 3)
(JRST 14)
(LABEL 13) (MOVE O1 -5 Q)
(MOVE O3 1 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 NIL)
(CALL LIST* 3)
(MOVEM O1 -4 Q)
(MOVE O2 -8 Q)
(CALL CONS 2)
(MOVEM O1 -8 Q)
(LABEL 14) (JRST 10)
(LABEL 12) (SKIPN NIL -13 Q)
(JRST 16)
(MOVE O1 -5 Q)
(MOVE O1 0 O1)
(CALL LISTP 1)
(SKIPN NIL O1)
(LABEL 16) (JRST 15)
(MOVE O1 -5 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O2 -7 Q)
(MOVE O1 O5)
(CALL APPEND 2)
(MOVEM O1 -7 Q)
(MOVE O1 -5 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O2 -12 Q)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O5 O1)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -11 Q)
(MOVE O3 -3 Q)
(MOVE O4 (CONSTANT 6))
(CALL LIST 5)
(MOVEM O1 -4 Q)
(MOVE O1 -5 Q)
(MOVE O3 1 O1)
(MOVE O1 -4 Q)
(MOVE O2 NIL)
(CALL LIST* 3)
(MOVEM O1 -4 Q)
(MOVE O2 -8 Q)
(CALL CONS 2)
(MOVEM O1 -8 Q)
(JRST 10)
(LABEL 15) (SKIPA)
(JRST 18)
(MOVE O1 -5 Q)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O2 -7 Q)
(MOVE O1 O5)
(CALL CONS 2)
(MOVEM O1 -7 Q)
(MOVE O1 -5 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 -12 Q)
(MOVE O2 -11 Q)
(CALL LIST 3)
(MOVEM O1 -4 Q)
(MOVE O1 -5 Q)
(MOVE O3 1 O1)
(MOVE O1 -4 Q)
(MOVE O2 NIL)
(CALL LIST* 3)
(MOVEM O1 -4 Q)
(MOVE O2 -8 Q)
(CALL CONS 2)
(MOVEM O1 -8 Q)
(LABEL 18)
(LABEL 10) (MOVE O1 -6 Q)
(MOVE O1 1 O1)
(MOVEM O1 -6 Q)
(MOVE O1 0 O1)
(MOVEM O1 -5 Q)
(JRST 7)
(LABEL 3) (SKIPN NIL -17 Q)
(JRST 20)
(MOVE O2 -15 Q)
(MOVE O1 -11 Q)
(CALL LIST 2)
(CALL LIST 1)
(MOVEM O1 -6 Q)
(MOVE O1 -8 Q)
(CALL NREVERSE 1)
(MOVEM O1 -2 Q)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O5 O1)
(MOVE O1 (CONSTANT 13))
(MOVE O2 (CONSTANT 14))
(MOVE O3 (CONSTANT 15))
(MOVE O4 -11 Q)
(CALL LIST 5)
(MOVEM O1 -1 Q)
(MOVE O3 (CONSTANT 19))
(MOVE O1 (CONSTANT 18))
(MOVE O2 -15 Q)
(CALL LIST* 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 17))
(MOVE O2 -11 Q)
(CALL LIST 3)
(MOVEM O1 0 Q)
(MOVE O2 -10 Q)
(MOVE O1 (CONSTANT 20))
(CALL LIST 2)
(MOVE O5 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -1 Q)
(MOVE O3 (CONSTANT 16))
(MOVE O4 0 Q)
(CALL LIST 5)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -2 Q)
(CALL APPEND 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 12))
(CALL CONS 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -9 Q)
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 10))
(MOVE O2 -10 Q)
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 9))
(MOVE O2 -9 Q)
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -6 Q)
(CALL LIST 3)
(JRST 21)
(LABEL 20) (MOVE O2 -15 Q)
(MOVE O1 -11 Q)
(CALL LIST 2)
(CALL LIST 1)
(MOVEM O1 -6 Q)
(MOVE O1 -8 Q)
(CALL NREVERSE 1)
(MOVEM O1 -4 Q)
(SKIPN NIL -18 Q)
(JRST 22)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O4 O1)
(MOVE O1 (CONSTANT 21))
(MOVE O2 -18 Q)
(MOVE O3 -11 Q)
(CALL LIST 4)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 3))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(JRST 23)
(LABEL 22) (MOVE O2 NIL)
(LABEL 23) (MOVE O1 -4 Q)
(CALL APPEND 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 12))
(CALL CONS 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -6 Q)
(CALL LIST 3)
(LABEL 21) (SUBI Q 19)
(POPJ P)
)
(%PUT (QUOTE CASE-BODY) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (NAME KEYFORM CASES MULTI-P TEST ERROR-STRING PROCEED-STRING)))
(%PUT (QUOTE CASE-BODY) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE CASE-BODY) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "CASE Keyform {({(Key*) | Key} Form*)}*
Evaluates the Forms in the first clause with a Key EQL to the value of
Keyform. If a singleton key is T then the clause is a default clause."))
#_(LAP #0_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." CASE T EQL)
(CODE-START)
(LABEL 1) (ADDI Q 9)
(MOVEM O1 -8 Q)
(CALL LENGTH 1)
(MOVEM O1 -7 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -8 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 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -5 Q)
(MOVE O5 (CONSTANT 2))
(MOVEM O5 -4 Q)
(MOVE O5 -6 Q)
(MOVEM O5 -3 Q)
(MOVE O5 -5 Q)
(MOVEM O5 -2 Q)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 -1 Q)
(MOVE O5 (CONSTANT 4))
(MOVEM O5 0 Q)
(PUSH Q NIL)
(PUSH Q NIL)
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVE O5 -2 Q)
(CALL LISP::CASE-BODY 7)
(LABEL 5)
(LABEL 3) (SUBI Q 9)
(POPJ P)
)
(%PUT (QUOTE CASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (KEYFORM &BODY CASES)))
(%PUT (QUOTE CASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE CASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CCASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "CCASE Keyform {({(Key*) | Key} Form*)}*
Evaluates the Forms in the first clause with a Key EQL to the value of
Keyform. If none of the keys matches then a correctable error is
signalled."))
#_(LAP #0_CCASE 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." CCASE T EQL "CCASE key ~S is not any of the following:~% ~S" "prompt for a new key value to use in its place.")
(CODE-START)
(LABEL 1) (ADDI Q 9)
(MOVEM O1 -8 Q)
(CALL LENGTH 1)
(MOVEM O1 -7 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -8 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 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -5 Q)
(MOVE O5 (CONSTANT 2))
(MOVEM O5 -4 Q)
(MOVE O5 -6 Q)
(MOVEM O5 -3 Q)
(MOVE O5 -5 Q)
(MOVEM O5 -2 Q)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 -1 Q)
(MOVE O5 (CONSTANT 4))
(MOVEM O5 0 Q)
(PUSH Q (CONSTANT 5))
(PUSH Q (CONSTANT 6))
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVE O5 -2 Q)
(CALL LISP::CASE-BODY 7)
(LABEL 5)
(LABEL 3) (SUBI Q 9)
(POPJ P)
)
(%PUT (QUOTE CCASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (KEYFORM &BODY CASES)))
(%PUT (QUOTE CCASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE CCASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ECASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "ECASE Keyform {({(Key*) | Key} Form*)}*
Evaluates the Forms in the first clause with a Key EQL to the value of
Keyform. If none of the keys matches then an error is signalled."))
#_(LAP #0_ECASE 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." ECASE T EQL "ECASE key ~S is not any of the following:~% ~S")
(CODE-START)
(LABEL 1) (ADDI Q 9)
(MOVEM O1 -8 Q)
(CALL LENGTH 1)
(MOVEM O1 -7 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -8 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 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -5 Q)
(MOVE O5 (CONSTANT 2))
(MOVEM O5 -4 Q)
(MOVE O5 -6 Q)
(MOVEM O5 -3 Q)
(MOVE O5 -5 Q)
(MOVEM O5 -2 Q)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 -1 Q)
(MOVE O5 (CONSTANT 4))
(MOVEM O5 0 Q)
(PUSH Q (CONSTANT 5))
(PUSH Q NIL)
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVE O5 -2 Q)
(CALL LISP::CASE-BODY 7)
(LABEL 5)
(LABEL 3) (SUBI Q 9)
(POPJ P)
)
(%PUT (QUOTE ECASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (KEYFORM &BODY CASES)))
(%PUT (QUOTE ECASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE ECASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE TYPECASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "TYPECASE Keyform {(Type Form*)}*
Evaluates the Forms in the first clause for which TYPEP of Keyform and Type
is true."))
#_(LAP #0_TYPECASE 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." TYPECASE TYPEP)
(CODE-START)
(LABEL 1) (ADDI Q 9)
(MOVEM O1 -8 Q)
(CALL LENGTH 1)
(MOVEM O1 -7 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -8 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 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -5 Q)
(MOVE O5 (CONSTANT 2))
(MOVEM O5 -4 Q)
(MOVE O5 -6 Q)
(MOVEM O5 -3 Q)
(MOVE O5 -5 Q)
(MOVEM O5 -2 Q)
(MOVEM NIL -1 Q)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 0 Q)
(PUSH Q NIL)
(PUSH Q NIL)
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVE O5 -2 Q)
(CALL LISP::CASE-BODY 7)
(LABEL 5)
(LABEL 3) (SUBI Q 9)
(POPJ P)
)
(%PUT (QUOTE TYPECASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (KEYFORM &BODY CASES)))
(%PUT (QUOTE TYPECASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE TYPECASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE CTYPECASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "CTYPECASE Keyform {(Type Form*)}*
Evaluates the Forms in the first clause for which TYPEP of Keyform and Type
is true. If no form is satisfied then a correctable error is signalled."))
#_(LAP #0_CTYPECASE 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." CTYPECASE TYPEP "CTYPECASE key ~S is not of any of the following types:~% ~S." "prompt for a new object to use in its place.")
(CODE-START)
(LABEL 1) (ADDI Q 9)
(MOVEM O1 -8 Q)
(CALL LENGTH 1)
(MOVEM O1 -7 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -8 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 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -5 Q)
(MOVE O5 (CONSTANT 2))
(MOVEM O5 -4 Q)
(MOVE O5 -6 Q)
(MOVEM O5 -3 Q)
(MOVE O5 -5 Q)
(MOVEM O5 -2 Q)
(MOVEM NIL -1 Q)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 0 Q)
(PUSH Q (CONSTANT 4))
(PUSH Q (CONSTANT 5))
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVE O5 -2 Q)
(CALL LISP::CASE-BODY 7)
(LABEL 5)
(LABEL 3) (SUBI Q 9)
(POPJ P)
)
(%PUT (QUOTE CTYPECASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (KEYFORM &BODY CASES)))
(%PUT (QUOTE CTYPECASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE CTYPECASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE ETYPECASE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "ETYPECASE Keyform {(Type Form*)}*
Evaluates the Forms in the first clause for which TYPEP of Keyform and Type
is true. If no form is satisfied then an error is signalled."))
#_(LAP #0_ETYPECASE 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." ETYPECASE TYPEP "ETYPECASE key ~S is not of any of the following types:~% ~S.")
(CODE-START)
(LABEL 1) (ADDI Q 9)
(MOVEM O1 -8 Q)
(CALL LENGTH 1)
(MOVEM O1 -7 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -8 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 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -6 Q)
(MOVE O1 -8 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -5 Q)
(MOVE O5 (CONSTANT 2))
(MOVEM O5 -4 Q)
(MOVE O5 -6 Q)
(MOVEM O5 -3 Q)
(MOVE O5 -5 Q)
(MOVEM O5 -2 Q)
(MOVEM NIL -1 Q)
(MOVE O5 (CONSTANT 3))
(MOVEM O5 0 Q)
(PUSH Q (CONSTANT 4))
(PUSH Q NIL)
(MOVE O1 -6 Q)
(MOVE O2 -5 Q)
(MOVE O3 -4 Q)
(MOVE O4 -3 Q)
(MOVE O5 -2 Q)
(CALL LISP::CASE-BODY 7)
(LABEL 5)
(LABEL 3) (SUBI Q 9)
(POPJ P)
)
(%PUT (QUOTE ETYPECASE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (KEYFORM &BODY CASES)))
(%PUT (QUOTE ETYPECASE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE ETYPECASE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE WITH-OPEN-FILE) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Bindspec is of the form (Stream File-Name . Options). The file whose name
is File-Name is opened using the Options and bound to the variable Stream.
The Forms are executed, and when they terminate, normally or otherwise,
the file is closed."))
#_(LAP #0_WITH-OPEN-FILE 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." WITH-OPEN-FILE LET OPEN UNWIND-PROTECT PROGN CLOSE)
(CODE-START)
(LABEL 1) (ADDI Q 6)
(MOVEM O1 -5 Q)
(CALL LENGTH 1)
(MOVEM O1 -4 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -5 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 -5 Q)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -3 Q)
(MOVE O1 -5 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -2 Q)
(MOVE O1 -3 Q)
(MOVE O5 0 O1)
(MOVEM O5 -1 Q)
(MOVE O2 1 O1)
(MOVE O1 (CONSTANT 4))
(CALL CONS 2)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL LIST 2)
(CALL LIST 1)
(MOVEM O1 -1 Q)
(MOVE O2 -2 Q)
(MOVE O1 (CONSTANT 6))
(CALL CONS 2)
(MOVEM O1 0 Q)
(MOVE O1 -3 Q)
(MOVE O2 0 O1)
(MOVE O1 (CONSTANT 7))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 5))
(MOVE O2 0 Q)
(CALL LIST 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 3))
(MOVE O2 -1 Q)
(CALL LIST 3)
(LABEL 5)
(LABEL 3) (SUBI Q 6)
(POPJ P)
)
(%PUT (QUOTE WITH-OPEN-FILE) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (BINDSPEC &REST FORMS)))
(%PUT (QUOTE WITH-OPEN-FILE) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE WITH-OPEN-FILE) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE WITH-OPEN-STREAM) (QUOTE %FUN-DOCUMENTATION) (QUOTE "The form STREAM is evaluated and must produce a stream. The variable VAR
is bound with the stream as its values. The body is executed (as an implicit
Progn), and when it terminates, normally or otherwise, the stream is closed."))
#_(LAP #0_WITH-OPEN-STREAM 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." WITH-OPEN-STREAM DECLARE LET UNWIND-PROTECT SETQ PROGN CLOSE)
(CODE-START)
(LABEL 1) (ADDI Q 12)
(MOVEM O1 -11 Q)
(CALL LENGTH 1)
(MOVEM O1 -10 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -11 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 -11 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -9 Q)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -8 Q)
(MOVE O1 -11 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -7 Q)
(MOVEM O5 -6 Q)
(MOVEM NIL -5 Q)
(LABEL 10) (MOVE O1 -6 Q)
(MOVE O1 0 O1)
(CALL LISTP 1)
(JUMPE1 O1 13)
(MOVE O1 -6 Q)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -4 Q)
(MOVE O2 (CONSTANT 3))
(CAMN O2 -4 Q)
(LABEL 13) (JRST 11)
(CALL GENSYM 0)
(MOVEM O1 -3 Q)
(MOVE O2 -8 Q)
(MOVE O1 -9 Q)
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O2 -3 Q)
(CALL LIST 2)
(MOVEM O1 -2 Q)
(MOVE O2 -6 Q)
(MOVE O1 (CONSTANT 7))
(CALL CONS 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 6))
(MOVE O2 -3 Q)
(CALL LIST 3)
(MOVEM O1 0 Q)
(MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 8))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 5))
(MOVE O2 0 Q)
(CALL LIST 3)
(MOVEM O1 -1 Q)
(MOVE O2 -3 Q)
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 -5 Q)
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -2 Q)
(CALL LIST* 3)
(JRST 6)
(LABEL 11) (MOVE O1 -6 Q)
(MOVE O1 1 O1)
(MOVEM O1 -6 Q)
(JRST 10)
(LABEL 6)
(LABEL 5)
(LABEL 3) (SUBI Q 12)
(POPJ P)
)
(%PUT (QUOTE WITH-OPEN-STREAM) (QUOTE %ARGS-DOCUMENTATION) (QUOTE ((VAR STREAM) . BODY)))
(%PUT (QUOTE WITH-OPEN-STREAM) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE WITH-OPEN-STREAM) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE WITH-INPUT-FROM-STRING) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Binds the Var to an input stream that returns characters from String and
executes the body. See manual for details."))
#_(LAP #0_WITH-INPUT-FROM-STRING 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." WITH-INPUT-FROM-STRING :INDEX :START :END (:END :START :INDEX) DECLARE LET MAKE-STRING-INPUT-STREAM 0 UNWIND-PROTECT SETQ PROGN SETF FILE-POSITION CLOSE)
(CODE-START)
(LABEL 1) (ADDI Q 18)
(MOVEM O1 -17 Q)
(CALL LENGTH 1)
(MOVEM O1 -16 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -17 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 -17 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -15 Q)
(MOVE O1 -17 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -14 Q)
(MOVE O1 -17 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -13 Q)
(MOVEM NIL -12 Q)
(MOVE O2 O5)
(MOVE O1 (CONSTANT 3))
(CALL LISP::FIND-KEYWORD 2)
(MOVEM O1 -12 Q)
(JUMPE O1 7)
(MOVE O5 0 O1)
(MOVEM O5 -11 Q)
(JRST 6)
(LABEL 7) (SKIPA)
(JRST 8)
(MOVEM NIL -11 Q)
(LABEL 8)
(LABEL 6) (MOVE O2 -13 Q)
(MOVE O1 (CONSTANT 4))
(CALL LISP::FIND-KEYWORD 2)
(MOVEM O1 -12 Q)
(JUMPE O1 11)
(MOVE O5 0 O1)
(MOVEM O5 -10 Q)
(JRST 10)
(LABEL 11) (SKIPA)
(JRST 12)
(MOVEM NIL -10 Q)
(LABEL 12)
(LABEL 10) (MOVE O2 -13 Q)
(MOVE O1 (CONSTANT 5))
(CALL LISP::FIND-KEYWORD 2)
(MOVEM O1 -12 Q)
(JUMPE O1 15)
(MOVE O5 0 O1)
(MOVEM O5 -9 Q)
(JRST 14)
(LABEL 15) (SKIPA)
(JRST 16)
(MOVEM NIL -9 Q)
(LABEL 16)
(LABEL 14) (MOVE O1 -17 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -8 Q)
(MOVE O2 (CONSTANT 6))
(MOVE O1 -13 Q)
(CALL LISP::KEYWORD-TEST 2)
(MOVE O5 -8 Q)
(MOVEM O5 -7 Q)
(MOVEM NIL -6 Q)
(LABEL 22) (MOVE O1 -7 Q)
(MOVE O1 0 O1)
(CALL LISTP 1)
(JUMPE1 O1 25)
(MOVE O1 -7 Q)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(MOVE O2 (CONSTANT 7))
(CAMN O2 -5 Q)
(LABEL 25) (JRST 23)
(CALL GENSYM 0)
(MOVEM O1 -4 Q)
(SKIPN NIL -9 Q)
(JRST 27)
(MOVE O1 -10 Q)
(SKIPE NIL O1)
(MOVEM O1 -1 Q)
(JUMPN O1 29)
(MOVE O5 (CONSTANT 10))
(MOVEM O5 -1 Q)
(LABEL 29) (MOVE O4 -9 Q)
(MOVE O1 (CONSTANT 9))
(MOVE O2 -14 Q)
(MOVE O3 -1 Q)
(CALL LIST 4)
(MOVE O2 O1)
(JRST 28)
(LABEL 27) (MOVE O3 -10 Q)
(JUMPN O3 30)
(MOVE O3 (CONSTANT 10))
(LABEL 30) (MOVE O1 (CONSTANT 9))
(MOVE O2 -14 Q)
(CALL LIST 3)
(MOVE O2 O1)
(LABEL 28) (MOVE O1 -15 Q)
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O2 -4 Q)
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 13))
(CALL CONS 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 12))
(MOVE O2 -4 Q)
(CALL LIST 3)
(MOVEM O1 -1 Q)
(SKIPN NIL -11 Q)
(JRST 31)
(MOVE O2 -15 Q)
(MOVE O1 (CONSTANT 15))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 14))
(MOVE O2 -11 Q)
(CALL LIST 3)
(CALL LIST 1)
(MOVEM O1 0 Q)
(JRST 32)
(LABEL 31) (MOVEM NIL 0 Q)
(LABEL 32) (MOVE O2 -15 Q)
(MOVE O1 (CONSTANT 16))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 0 Q)
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 11))
(MOVE O2 -1 Q)
(CALL LIST* 3)
(MOVEM O1 -2 Q)
(MOVE O2 -4 Q)
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 -6 Q)
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 8))
(MOVE O2 -3 Q)
(CALL LIST* 3)
(JRST 18)
(LABEL 23) (MOVE O1 -7 Q)
(MOVE O1 1 O1)
(MOVEM O1 -7 Q)
(JRST 22)
(LABEL 18)
(LABEL 5)
(LABEL 3) (SUBI Q 18)
(POPJ P)
)
(%PUT (QUOTE WITH-INPUT-FROM-STRING) (QUOTE %ARGS-DOCUMENTATION) (QUOTE ((VAR STRING &KEY INDEX START END) . BODY)))
(%PUT (QUOTE WITH-INPUT-FROM-STRING) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE WITH-INPUT-FROM-STRING) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE WITH-OUTPUT-TO-STRING) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Binds the Var to a string output stream that puts characters into String
and executes the body. See manual for details."))
#_(LAP #0_WITH-OUTPUT-TO-STRING 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." WITH-OUTPUT-TO-STRING DECLARE LET MAKE-FILL-POINTER-OUTPUT-STREAM UNWIND-PROTECT SETQ PROGN CLOSE ((MAKE-STRING-OUTPUT-STREAM)) GET-OUTPUT-STREAM-STRING)
(CODE-START)
(LABEL 1) (ADDI Q 13)
(MOVEM O1 -12 Q)
(CALL LENGTH 1)
(MOVEM O1 -11 Q)
(MOVE O2 (CONSTANT 0))
(CALL < 2)
(JUMPE O1 4)
(MOVE O1 -12 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 -12 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -10 Q)
(MOVE O1 -12 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(SKIPN NIL 1 O1)
(JRST 7)
(MOVE O1 -12 Q)
(MOVE O1 1 O1)
(MOVE O1 0 O1)
(MOVE O1 1 O1)
(MOVE O5 0 O1)
(MOVEM O5 -9 Q)
(JRST 6)
(LABEL 7) (SKIPA)
(JRST 8)
(MOVEM NIL -9 Q)
(LABEL 8)
(LABEL 6) (MOVE O1 -12 Q)
(MOVE O1 1 O1)
(MOVE O5 1 O1)
(MOVEM O5 -8 Q)
(MOVEM O5 -7 Q)
(MOVEM NIL -6 Q)
(LABEL 14) (MOVE O1 -7 Q)
(MOVE O1 0 O1)
(CALL LISTP 1)
(JUMPE1 O1 17)
(MOVE O1 -7 Q)
(MOVE O1 0 O1)
(MOVE O5 0 O1)
(MOVEM O5 -5 Q)
(MOVE O2 (CONSTANT 3))
(CAMN O2 -5 Q)
(LABEL 17) (JRST 15)
(SKIPN NIL -9 Q)
(JRST 19)
(CALL GENSYM 0)
(MOVEM O1 -4 Q)
(MOVE O2 -9 Q)
(MOVE O1 (CONSTANT 5))
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 -10 Q)
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O2 -4 Q)
(CALL LIST 2)
(MOVEM O1 -3 Q)
(MOVE O2 -7 Q)
(MOVE O1 (CONSTANT 8))
(CALL CONS 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 7))
(MOVE O2 -4 Q)
(CALL LIST 3)
(MOVEM O1 0 Q)
(MOVE O2 -10 Q)
(MOVE O1 (CONSTANT 9))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 6))
(MOVE O2 0 Q)
(CALL LIST 3)
(MOVEM O1 -1 Q)
(MOVE O2 -4 Q)
(CALL LIST 2)
(MOVE O2 O1)
(MOVE O1 -6 Q)
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -3 Q)
(CALL LIST* 3)
(JRST 20)
(LABEL 19) (MOVE O2 (CONSTANT 10))
(MOVE O1 -10 Q)
(CALL CONS 2)
(CALL LIST 1)
(MOVEM O1 -4 Q)
(MOVE O2 -10 Q)
(MOVE O1 (CONSTANT 11))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -7 Q)
(CALL APPEND 2)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 8))
(CALL CONS 2)
(MOVEM O1 -2 Q)
(MOVE O2 -10 Q)
(MOVE O1 (CONSTANT 9))
(CALL LIST 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 6))
(MOVE O2 -2 Q)
(CALL LIST 3)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -6 Q)
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 4))
(MOVE O2 -4 Q)
(CALL LIST* 3)
(LABEL 20) (JRST 10)
(LABEL 15) (MOVE O1 -7 Q)
(MOVE O1 1 O1)
(MOVEM O1 -7 Q)
(JRST 14)
(LABEL 10)
(LABEL 5)
(LABEL 3) (SUBI Q 13)
(POPJ P)
)
(%PUT (QUOTE WITH-OUTPUT-TO-STRING) (QUOTE %ARGS-DOCUMENTATION) (QUOTE ((VAR &OPTIONAL STRING) . BODY)))
(%PUT (QUOTE WITH-OUTPUT-TO-STRING) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE WITH-OUTPUT-TO-STRING) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOCALLY) (QUOTE %FUN-DOCUMENTATION) (QUOTE "A form providing a container for locally-scoped variables."))
#_(LAP #0_LOCALLY MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(LET)
(CODE-START)
(LABEL 1) (ADDI Q 2)
(MOVEM O1 -1 Q)
(MOVE O5 1 O1)
(MOVEM O5 0 Q)
(MOVE O3 O5)
(MOVE O1 (CONSTANT 0))
(MOVE O2 NIL)
(CALL LIST* 3)
(SUBI Q 2)
(POPJ P)
)
(%PUT (QUOTE LOCALLY) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST FORMS)))
(%PUT (QUOTE LOCALLY) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE LOCALLY) (QUOTE %SOURCE-DOCUMENTATION))))
(%PUT (QUOTE LOOP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Executes the body repeatedly until the form is exited by a Throw or
Return. The body is surrounded by an implicit block with name NIL."))
#_(LAP #0_LOOP MACRO
(ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
#0_(BLOCK TAGBODY GO)
(CODE-START)
(LABEL 1) (ADDI Q 3)
(MOVEM O1 -2 Q)
(MOVE O5 1 O1)
(MOVEM O5 -1 Q)
(CALL GENSYM 0)
(MOVEM O1 0 Q)
(MOVE O2 O1)
(MOVE O1 (CONSTANT 2))
(CALL LIST 2)
(CALL LIST 1)
(MOVE O2 O1)
(MOVE O1 -1 Q)
(CALL APPEND 2)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 1))
(MOVE O2 0 Q)
(CALL LIST* 3)
(MOVE O3 O1)
(MOVE O1 (CONSTANT 0))
(MOVE O2 NIL)
(CALL LIST 3)
(SUBI Q 3)
(POPJ P)
)
(%PUT (QUOTE LOOP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (&REST BODY)))
(%PUT (QUOTE LOOP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>MACROS.CLISP.29") (GET (QUOTE LOOP) (QUOTE %SOURCE-DOCUMENTATION))))