(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED " 5-Jan-88 12:45:55" {DSK}<XAVIER>TO-COMMONLISP.XFORMS;11
 143791 

      previous date%: "18-Nov-87 13:38:55" {DSK}<XAVIER>TO-COMMONLISP.XFORMS;10)


(* "
Copyright (c) 1987, 1988 by System Development Corp..  All rights reserved.
")

(PRETTYCOMPRINT XFORMSVARS)

(RPAQQ XFORMSVARS
 ((* Transformations from Interlisp-D to Common Lisp. These transformations were 
                      developed by System Development Group of UNISYS Corp. There is no guarantee of 
                      correctness, completeness or support for these transformations. Copyright
                      (C)
                      by UNISYS Corp. 1986, 1987.0 All rights reserved. Please direct suggestions for 
                      improvements and extensions to Darrel J. Van Buer (darrelj@RDCF.SM.UNISYS.COM)
                      or Richard Fritzson (fritzson@bigburd.PRC.Unisys.COM))
                   XFORMSFNS
                   (USERMACROS TESTORVAL)
                   (VARS XlatedRecords CommonLispComments DataTypeSpecialForms (CLISPARRAY NIL)
                         (CLISPIFTRANFLG NIL)
                         (NORMALCOMMENTSFLG T))
                   (P (SETQ TRANSOUTREADTABLE (COPYREADTABLE (FIND-READTABLE "XCL")))
                      (READTABLEPROP TRANSOUTREADTABLE 'CASEINSENSITIVE NIL))
                   (FNS COMPUTEFORMATS MAKELAMPROG DataTypeP STRINGIFY)
                   (TRANSAVE)
                   (PROP MAKEFILE-ENVIRONMENT TO-COMMONLISP TO-COMMONLISP.XFORMS)))



(* Transformations from Interlisp-D to Common Lisp. These transformations were developed by System 
Development Group of UNISYS Corp. There is no guarantee of correctness, completeness or support for 
these transformations. Copyright (C) by UNISYS Corp. 1986, 1987.0 All rights reserved. Please direct 
suggestions for improvements and extensions to Darrel J. Van Buer (darrelj@RDCF.SM.UNISYS.COM) or 
Richard Fritzson (fritzson@bigburd.PRC.Unisys.COM))



(RPAQQ XFORMSFNS
 NIL)

(ADDTOVAR USERMACROS
 
          (TESTORVAL NIL (E (SETQQ USAGE UNKNOWN)
                            T)
                 (ORR [(COMS (SELECTQ (%## !0 1)
                                    [(PROGN LAMBDA NLAMBDA AND SELECTQ)
                                     '(IF (EQ (%##)
                                              (%## !0 -1))
                                          (!0 TESTORVAL -1)
                                          ((E (SETQQ USAGE TEST)
                                              T]
                                    (PROG %' (E (SETQQ USAGE TEST)
                                                T))
                                    [PROG1 %' (IF (EQ (%##)
                                                      (%## !0 2))
                                                  (!0 TESTORVAL 2)
                                                  ((E (SETQQ USAGE TEST)
                                                      T]
                                    (OR '(COMSQ MARK !0 TESTORVAL __))
                                    (DO |'TTY:|)
                                    (RETURN %' (COMSQ MARK (BELOW PROG 0)
                                                      TESTORVAL __))
                                    (NIL NIL)
                                    (SELECTQ (%## !0 !0 1)
                                           [(SELECTQ COND)
                                            '(IF (EQ (%##)
                                                     (%## !0 -1))
                                                 (MARK !0 !0 TESTORVAL __)
                                                 ((E (SETQQ USAGE TEST)
                                                     T]
                                           '(E (SETQQ USAGE VALUE)
                                               T]
                      NIL)))

(ADDTOVAR EDITCOMSA
 TESTORVAL)

(RPAQQ XlatedRecords
 
       (assertedfacts agendaitem QUESTION FC-MENUITEM 2ndOrderOp AggForm BagForm Entailment 
              QuantifiedFormula IMPlication RIMPlication BICONDitional BinaryOperation Negation 
              AccessSpecification Computation RestrictionTest))

(RPAQQ CommonLispComments
 
       (CLISP FEATURES ARE PRIMARILY HANDLED BY DW COMMAND IN LAMBDA TRANSFORMATION. THIS WORKS FOR 
              RECORD PACKAGE TOO, IF ANY DATATYPE OR ARRAYRECORD (AND SINCE GETHASH/PUTHASH ARE 
                                                                      UNSUPPORTED, HASHRECORD)
              DECLARATIONS ARE MODIFIED TO SOME OTHER TYPE. NOTE THAT DECLARATION FORMS LIKE
              (BITS 5)
              HAVE TO BE REMOVED IN THIS REDECLARATION. IF ABILITY TO DETERMINE TYPE OF A RECORD IS 
              IMPORTANT, TYPERECORD DECLARATIONS WILL DO. IF ACCESS TIME IS IMPORTANT, RECORDS WITH A 
              BALANCED OR B-TREE LAYOUT MAY BE ADEQUATE))

(RPAQQ DataTypeSpecialForms
 (create fetch ffetch replace freplace))

(RPAQQ CLISPARRAY
 NIL)

(RPAQQ CLISPIFTRANFLG
 NIL)

(RPAQQ NORMALCOMMENTSFLG
 T)
(SETQ TRANSOUTREADTABLE (COPYREADTABLE (FIND-READTABLE "XCL")))
(READTABLEPROP TRANSOUTREADTABLE 'CASEINSENSITIVE NIL)
(DEFINEQ

(COMPUTEFORMATS

  [LAMBDA (PRINTOUTARGS)
                                     (* ; "Edited 20-Oct-87 12:28 by DJVB")

          
          (* INPUT IS LIST OF ARGS TO PRINTOUT -- AFTER THE FILE ARG.

          RESULT SHOULD BE THE LIST OF ARGS NEEDED BY FORMAT TO DO THE SAME THING)


    (PROG ((FMTSTR (CONCAT))
           FMTARGS)
      LP  [COND
             ((NULL PRINTOUTARGS)
              (RETURN (CONS FMTSTR FMTARGS]
          [SELECTQ (CAR PRINTOUTARGS)
              (.TAB [if
 (FIXP (CADR PRINTOUTARGS)
                              then
                              (SETQ FMTSTR (CONCAT FMTSTR "~" (CADR PRINTOUTARGS)
                                                  "T"))
                              else
                              (SETQ FMTSTR (CONCAT FMTSTR "~VT"))
                              (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS]
                    (pop
 PRINTOUTARGS))
              (.TAB0 [if
 (FIXP (CADR PRINTOUTARGS)
                               then
                               (SETQ FMTSTR (CONCAT FMTSTR "~" (CADR PRINTOUTARGS)
                                                   ",0T"))
                               else
                               (SETQ FMTSTR (CONCAT FMTSTR "~V,0T"))
                               (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS]
                     (pop
 PRINTOUTARGS))
              (%, (SETQ FMTSTR (CONCAT FMTSTR "~@T")))
              (%,, (SETQ FMTSTR (CONCAT FMTSTR "~2@T")))
              (%,,, (SETQ FMTSTR (CONCAT FMTSTR "~3@T")))
              (.SP (SETQ FMTSTR (CONCAT FMTSTR "~V@T"))
                   (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS)))
                   (pop
 PRINTOUTARGS))
              ((T 0) 
                   (SETQ FMTSTR (CONCAT FMTSTR "~%%")))
              (.SKIP [if
 (FIXP (CADR PRINTOUTARGS))
                         then
 (SETQ FMTSTR (CONCAT FMTSTR "~" (CADR PRINTOUTARGS)
                                                  "%%"))
                       else
 (SETQ FMTSTR (CONCAT FMTSTR "~V%%")
                             (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS]
                     (pop
 PRINTOUTARGS))
              (.PAGE (SETQ FMTSTR (CONCAT FMTSTR "~|")))
              (|.P2| (SETQ FMTSTR (CONCAT FMTSTR "~S"))
                     (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS)))
                     (pop
 PRINTOUTARGS))
              ((.SUP .SUB .BASE) 
          
          (* DON'T KNOW HOW TO HANDLE THIS, SO DO A REMARK)


                   (KEEPLIST PRINTOUTSUB%:))
              ((.FONT %#) 
          
          (* DON'T KNOW HOW TO HANDLE THIS, SO DO A REMARK)


                   (KEEPLIST PRINTOUTFONT%:)
                   (CLISP%  (PROG1 (CAR PRINTOUTARGS)
                                   (SETQ PRINTOUTARGS (CDR PRINTOUTARGS)))
                          pop PRINTOUTARGS))
              ((.PPF .PPV .PPFTL .PPVTL) 
          
          (* DON'T KNOW HOW TO HANDLE THIS, SO DO A REMARK)


                   (KEEPLIST PRINTOUT%:)
                   (SETQ FMTSTR (CONCAT FMTSTR "~A"))
                   (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS)))
                   (pop
 PRINTOUTARGS))
              ((.N .FR .FR2) 
          
          (* DON'T KNOW HOW TO HANDLE THIS, SO DO A REMARK)


                   (KEEPLIST PRINTOUT%:)
                   (pop
 PRINTOUTARGS)
                   (SETQ FMTSTR (CONCAT FMTSTR "~A"))
                   (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS)))
                   (pop
 PRINTOUTARGS))
              ((.PARA .PARA2) 
          
          (* DON'T KNOW HOW TO HANDLE THIS, SO DO A REMARK)


                   (KEEPLIST PRINTOUT%:)
                   (SETQ FMTSTR (CONCAT FMTSTR "~A"))
                   (pop
 PRINTOUTARGS)
                   (pop
 PRINTOUTARGS)
                   (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS)))
                   (pop
 PRINTOUTARGS))
              (COND
                 [(FIXP (CAR PRINTOUTARGS))                  (* TAB OR SPACES SHORTHAND)

                  (COND
                     ((MINUSP (CAR PRINTOUTARGS))            (* SPACES)

                      (SETQ FMTSTR (CONCAT FMTSTR "~" (IMINUS (CAR PRINTOUTARGS))
                                          "@T")))
                     (T (SETQ FMTSTR (CONCAT FMTSTR "~" (CAR PRINTOUTARGS)
                                            "T"]
                 ((FASSOC (CAR PRINTOUTARGS)
                         PRINTOUTMACROS)
          
          (* DON'T KNOW HOW TO HANDLE THIS, SO DO A REMARK)


                  (KEEPLIST PRINTOUTMACROS%:))
                 ([AND (LITATOM (CAR PRINTOUTARGS))
                       (MEMB (SUBATOM (CAR PRINTOUTARGS)
                                    1 2)
                             '(.I .F]                        (* NUMERIC FORMAT REQUEST)

                  [SETQ FMTSTR
                   (CONCAT
                    FMTSTR
                    (CADDR
                     (TRANSORFORM
                      `(PRINTNUM
                        ',[CONS (COND
                                   ((EQ (SUBATOM (CAR PRINTOUTARGS)
                                               2 2)
                                        'I)
                                    'FIX)
                                   (T 'FLOAT))
                                (while
 POINT bind
 (POINT _ 2)
                                   collect
 (SUBATOM (CAR PRINTOUTARGS)
                                                  (ADD1 POINT)
                                                  (AND (SETQ POINT (STRPOS "." (CAR PRINTOUTARGS)
                                                                          (ADD1 POINT)))
                                                       (SUB1 POINT] 0]
                  (SETQ FMTARGS (NCONC1 FMTARGS (CADR PRINTOUTARGS)))
                  (pop
 PRINTOUTARGS))
                 [[AND (STRINGP (CAR PRINTOUTARGS))
                       (NULL (STRPOS "~" (CAR PRINTOUTARGS]
                  (SETQ FMTSTR (CONCAT FMTSTR (CAR PRINTOUTARGS]
                 [[AND (EQ 'QUOTE (CAAR PRINTOUTARGS))
                       (LITATOM (CADAR PRINTOUTARGS))
                       (NULL (STRPOS "~" (CADAR PRINTOUTARGS]
                  (SETQ FMTSTR (CONCAT FMTSTR (CADAR PRINTOUTARGS]
                 (T (SETQ FMTSTR (CONCAT FMTSTR "~A")
                     (SETQ FMTARGS (NCONC1 FMTARGS (CAR PRINTOUTARGS]
          (CLISP%  (PROG1 (CAR PRINTOUTARGS)
                          (SETQ PRINTOUTARGS (CDR PRINTOUTARGS)))
                 pop PRINTOUTARGS)
          (GO LP])

(MAKELAMPROG

  [LAMBDA (PRG)
                                              (* ; "Edited 26-Mar-87 12:03 by DJVB")


    (PROG ([INITV (for
 X in
 (CADR PRG) collect
 (CAR X) when
 (is X (A LIST]
           [INITVAL (for
 X in
 (CADR PRG) when
 (is X (A LIST)) collect
 (COND
                                                                         ((EQLENGTH X 2)
                                                                          (CADR X))
                                                                         (T (CDR X]
           (NONINITV (for
 X in
 (CADR PRG) unless
 (is X (A LIST)) collect
 X)))
          (RETURN (CONS [LIST 'LAMBDA INITV (CONS (CAR PRG)
                                                  (CONS NONINITV (CDDR PRG]
                        INITVAL])

(DataTypeP

  [LAMBDA (x)
                                                (* RichardFritzson " 5-Dec-86 06:46")

    (PROG [(Y (COND
                 ((LITATOM x)
                  x)
                 (T (CADR x]
          (RETURN (OR (DATATYPEP x)
                      (COND
                         ((LITATOM x)
                          (MEMB x XlatedRecords))
                         (T (MEMB (CAR x)
                                  XlatedRecords)))
                      (EQ (CAAR (FIELDLOOK Y))
                          'DATATYPE)
                      (AND (EQ (CAAR (FIELDLOOK Y))
                               'RECORD)
                           (MEMB Y XlatedRecords])

(STRINGIFY

  [LAMBDA (STRLIST)
                                          (* ; "Edited 18-Nov-87 11:13 by DJVB")


    (LET ((PARTIAL ""))
         [CLISP%  [MAP STRLIST (FUNCTION (LAMBDA (X)
                                           (COND
                                              ((CDR X)
                                               (SETQ PARTIAL (CONCAT PARTIAL (CAR X)
                                                                    " ")))
                                              (T (SETQ PARTIAL (CONCAT PARTIAL (CAR X]
                for X on STRLIST do
 (COND
                                       ((CDR X)
                                        (SETQ PARTIAL (CONCAT PARTIAL (CAR X)
                                                             " ")))
                                       (T (SETQ PARTIAL (CONCAT PARTIAL (CAR X]
         PARTIAL])
)

(RPAQQ DUMPFILE
 TO-COMMONLISP.XFORMS)

(RPAQQ USERNOTES
 ((/SETATOMVAL%: (* XFORM CORRECT ONLY FOR DEEP BOUND SYSTEM))
                  (ADDLAST%: (* CHANGETRAN FAILED TO DWIMIFY))
                  (APROPOS%: (* UNSUPPORTED FEATURE))
                  (ASSOC%: (* ASSOC NOT CHANGED, SO USES EQL NOT EQ))
                  (BLAMBDA1 (* NON-ATOMIC CAR OF FORM NOT AN INLINE LAMBDA. APPLY* INSERTED.))
                  (BLAMBDA2 (* DISAGREEMENT IN ARG COUNT BETWEEN LAMBDA LIST AND ARGS.))
                  (BLAMBDA3 (* LAMBDA EXPRESSION LACKS A BODY))
                  (BREAK%: (* UNRELATED TO CL%:BREAK))
                  (CHARCODE%: (* CHAR-INT CORRESPONDS TO CHARCODE BUT CHAR NAMES MAY NOT))
                  (CLOCK1%: (* CLOCK not translated))
                  (CLOCK%: (* CLOCK SEMANTICS PRESERVED BUT MAY BE SIMPLER IN CONTEXT))
                  (COMPILE%: (* IL%:COMPILE TAKES LIST OR SINGLE ITEM, CL%:COMPILE TAKES ONLY SINGLE 
                                ITEM. NOT CHANGABLE AUTOMATICALLY))
                  (CONSCOUNT%: (* CONSCOUNT NONOPERATIONAL))
                  (CONSTANTS%: (* DONT HAVE VALUE FOR CONSTANT, AND NO EASY WAY TO FIND IT 
                                  AUTOMATICALLY, ALTHOUGH IT MAY HAVE APPEARED A FEW LINES BACK IN 
                                  THE FILE. IN AT LEAST SOME CL %,THE EASY TRANSLATION OF WHAT A 
                                  CONSTANTS FILECOM EXPANDS INTO IS (DEFPARAMETER VAR 'GLOBALVALUE)
                                  (DEFCONSTANT VAR)
                                  %,BUT THIS OFTEN LEAVES YOU WITH A CONSTANT SET TO NIL -- AND 
                                  RESISTANT TO CORRECTION))
                  (COPYALL%: (* CommonLisp does not have a COPYALL. COPY-TREE was used.))
                  (COUNT%: (* TOTALLY UNRELATED TO CL%:COUNT, AND NO EQUIVALENT?))
                  (DATATYPES (* Record not a DATATYPE -- trying DWIM translation))
                  (DATE%: (* DATE FORMATTED TO INTERLISP DEFAULT. INLINE EXPANSION USED MAY BE 
                             UNDESIRABLE IF USED MUCH))
                  (DECLARE1%: (* SPECIAL DECLARATION MAY NEED TO BE MOVED TO RIGHT LEXICAL SCOPE))
                  (DECLARE%: (* MULTIPLE DECLARATION TOO COMPLEX))
                  (DEFPRINT%: (* DEFPRINT BECOMES A (%:PRINT-FUNCTION --)
                                 OPTION TO THE DEFSTRUCT FOR THE FIRST ARGUMENT, BUT THE CONVENTIONS 
                                 ALSO DIFFER IN DEFINITION, SO YOU WILL HAVE TO MANUALLY EDIT THE 
                                 SECOND ARGUMENT FUNCTION AS WELL))
                  (DIRECTORYNAME%: (* HARD CASE OF DIRECTORYNAME))
                  (DREMOVE%: (* DREMOVE/DELQ FOR EFFECT DIFFERS. IN COMMONLISP A SIDE EFFECT IS NOT 
                                GUARANTEED WHILE INTERLISP ONLY FAILS FOR EFFECT IF WHOLE LIST 
                                DELETED))
                  (DRIBBLE%: (* CANT DO APPEND/THAWWED IN CL))
                  (ERROR!%: (* ERROR! TRANSLATION USES "PROPOSED" CL ERROR SYSTEM STANDARD. YOUR 
                               MILAGE MAY VARY (TRY SOME KIND OF THROW REWRITE IF IT FAILS)))
                  (ERRORSET%: (* ERRORSET not translated))
                  (ERSETQ%: (* ERSETQ not translated))
                  (EVERY%: (* EVERY not translated))
                  (FILENAMEFIELD%: (* CAN'T TRANSFORM FILENAMEFIELD WITH VARIABLE FIELD))
                  (FNTYP%: (* TRANSFORM ONLY CAPTURES USE AS PREDICATE TO TEST FOR DEFINITION))
                  (FORCEOUTPUT%: (* CAN'T TRANSLATE VARIABLE FOR WAITFLG))
                  (FUNCTION%: (* Transformation is mangling a FUNCTION expression))
                  (GETFILEINFO%: (* UNSUPPORTED OR VARIABLE ATTRIBUTE IN GETFILEINFO))
                  (IDATE%: (* ARG TO IDATE NEEDS WORK))
                  (INTERLISP-ATOM (* Interlisp ATOM is true of Literal Atoms and Numbers only. Common 
                                     Lisp ATOM is true of anything which is not a CONS))
                  [KWOTE%: (* NEED (DEFUN KWOTE (X)
                                          (COND ((OR (NULL X)
                                                     (EQL X T)
                                                     (NUMBERP X))
                                                 X)
                                                (T (LIST 'QUOTE X]
                  (LDIFF%: (* CommonLisp LDIFF does not produce an error when argument#2 is not a 
                              tail of argument#1.))
                  (LISPXUNREAD%: (* LISPXUNREAD not translated))
                  (LISTP1%: (* THIS IS A CONSERVATIVE CHANGE FOR LISTP. FOR SIMPLE EXPRESSIONS, 
                               TRANSLATION IS EXACT BUT MORE EXPENSIVE IF REALLY TEST ONLY. FOR 
                               COMPLEX EXPRESSIONS USED FOR VALUE, CHANGES ARE NEEDED))
                  (LISTP%: (* MESSY LISTP, VERIFY USE REALLY FOR VALUE))
                  (LOAD%: (* LOAD OPTIONS NOT IN CL))
                  (LOAD?%: (* NOW UNCONDITIONAL LOAD))
                  (LOGOUT%: (* LOGOUT/EXIT NOT IN CL STANDARD YET))
                  (MAP2C%: (* MAP2C WITH TAIL FN NOT DONE))
                  (MAPHASH%: (* CL%:MAPHASH APPLY FN HAS OPPOSITE ORDER FROM IL. LAMBDA LIST NOT 
                                LOCATED SO NOT TRANSFORMED))
                  (MKSTRING%: (* CANT SIMULATE MKSTRING VIA READTABLE))
                  (NLAMBDA%: (* NO NLAMBDA IN COMMON LISP -- TRY A MACRO -- IF ARGLIST IS LITATOM, A 
                                MACRO WITH (&REST ARG)
                                FOR ARGLIST))
                  (NLEFT%: (* DID INLINE EXPANSION FOR NLEFT, MAY WANT TO DEFINE FUNCTION IF USED 
                              MUCH))
                  (NLSETQ%: (* ERSETQ AND NLSETQ HAVE BEEN TRANSLATED WITH PROPOSED ANSI CL ERROR 
                               HANDLING EXTENSIONS. MAY NOT WORK IN ALL LISPS.))
                  (NO-TRANSFORMATION-NEEDED (* THE FOLLOWING FUNCTIONS SEEM TO BE THE SAME
                                               (OF CL IS A SAFE SUPERSET)
                                               AND THUS HAVE NO TRANSFORMATIONS, OR HAVE 
                                               TRANSFORMATIONS TO WARN OF ODD CASES WHICH DON'T MAP 
                                               OR TO PROCESS THE CORRECT SYNTAX OF A SPECIAL FORM.
                                               (ABS AND APPLY BOUNDP BQUOTE BYTE CLRHASH COND 
                                                    DIRECTORY (IN SIMPLE CASES ANYWAY)
                                                    DPB DRIBBLE EQ EQUAL EVAL EXPT FLOAT GCD GENSYM 
                                                    GETHASH GO INSPECT INTERSECTION LAST LDB LET LET* 
                                                    LIST LIST* LOG LOGAND LOGNOT LOGXOR MAX MIN 
                                                    MINUSP NCONC NOT NULL OR POP PROG PROG1 PROG2 
                                                    PROGN QUOTE READ REMPROP RETURN REVERSE RPLACA 
                                                    RPLACD TRACE SET SETQ SUBST TAILP TERPRI UNION)))
                  (NTHCHAR%: (* FLG & RDTBL ARGS NEED TO DO (ELT (PRIN1-TO-STRING ARG1)
                                                                 ARG2)
                                TO GET IT RIGHT))
                  (NTYPX%: (* REWRITE INTO TYPEP SOMEHOW?))
                  (NUMBERP1%: (* MESSY NUMBERP, SHOULD VERIFY USE FOR VALUE))
                  (NUMBERP%: (* THIS IS A CONSERVATIVE CHANGE FOR NUMBERP/FIXP/... FOR SIMPLE 
                                EXPRESSIONS, TRANSLATION IS EXACT BUT MORE EXPENSIVE IF TEST ONLY. 
                                FOR COMPLEX EXPRESSIONS, WON'T WORK FOR VALUE))
                  (OPENFILE1%: (* NO PLACE IN CL OPEN FOR IL OPTIONS))
                  (OPENFILE2%: (* OLDEST RECOGNITION BELONG IN FILENAME AS %:VERSION %:OLDEST))
                  (OUTSIDE-CL%: (* FUNCTION IN AREA NOT ADDRESSED BY CL STANDARD
                                   (E.G. DISPLAY, PROCESSES, NETWORK)))
                  (PACKFILENAME1%: (* COMPUTED COMPONENT NAMES NOT TRANSLATED))
                  (PACKFILENAME%: (* NOT POSITION SENSITIVE IN CL. MAY NEED CHANGES))
                  (POSITION%: (* NO SUCH OPERATION IN CL?))
                  (PRINT%: (* Ugly translation of PRINT))
                  (PRINTDEF%: (* LEFT MARGIN OR TAILFLG IGNORED))
                  (PRINTNUM%: (* IMPERFECT TRANSLATION OF PRINTNUM))
                  (PRINTOUT%: (* PRINTOUT SPECIAL FORMATTING (E.G. PRETTYPRINTING)
                                 IGNORED))
                  (PRINTOUTFONT%: (* .FONT IGNORED IN PRINTOUT))
                  (PRINTOUTMACROS%: (* PRINTOUT MACRO NOT EXPANDED/TRANSLATED))
                  (PRINTOUTSUB%: (* PRINTOUT SUB/SUPERSCRIPTING IGNORED))
                  (PROMPTPRINT%: (* LOSES SOME OF THE SPIRIT OF PROMPTPRINT))
                  [PUTASSOC%: (* NEED (DEFUN PUTASSOC (KEY VAL ALST)
                                             (LET ((POS (ASSOC KEY ALST)))
                                                  (* THIS COULD HAVE BEEN WRITTEN AS AN UGLY PROG TO 
                                                     AVOID BOTH ASSOC AND NCONC HAVING TO SCAN THE 
                                                     LIST TO ADD A NEW ITEM)
                                                  (COND (POS (RPLACD POS VAL))
                                                        [(CONSP ALST)
                                                         (NCONC ALST (LIST (CONS KEY VAL]
                                                        (T (CERROR "Arg not list ~A" ALST)))
                                                  VAL]
                  (PUTPROPS1%: (* WIERD MACRO CASE))
                  (PUTPROPS%: (* NLAMBDA MACRO NOT SUPPORTED))
                  (RAND%: (* RAND OF EXPRESSION DEPENDS OF TYPE OF VALUE, FOR INT USE
                             (RANDOM (1+ EXP))
                             %, FOR FLOAT (RANDOM EXP)))
                  (READVISE%: (* READVISE not translated))
                  (RECORD1%: (* RECORD declaration incorrectly translated.))
                  (RESET%: (* RESETLST AND RELATIVES SOMEWHAT LIKE UNWIND-PROTECT, BUT YOU'RE ON YOUR 
                              OWN))
                  [SELECTC2%: (* SELECTC REQUIRES YOU TO DO
                                 (DEFMACRO SELECTC
 (SELECTOR &REST CASES)
                                    `[CASE ,SELECTOR ,@(for
 CASE on
 CASES while
 (CDR CASE)
                                                          collect
 (CONS (EVAL (CAAR CASE))
                                                                        (CDAR CASE)))
                                           (OTHERWISE ,(LAST CASES])
]
                  (SETN%: (* TOTALLY UNPORTABLE. SETN ISN'T EVEN SAFE BETWEEN DIFFERENT INTERLISPS!))
                  (SETSYNTAX%: (* CL READTABLES ONLY VAGUELY LIKE INTERLISP))
                  (SMALLP%: (* NO CL TEST FOR SMALLP, AT LEAST FIXNUM BETTER THAN BIGNUM))
                  (SQRT%: (* IN IL, (SQRT -1)
                             IS ERROR, IN CL IT'S %#C (0 1)))
                  (STRINGP1%: (* MESSY STRINGP, VERIFY USE FOR VALUE))
                  (STRINGP%: (* CONSERVATIVE STRINGP. FOR SIMPLE ARG, LESS EFFICIENT IF PREDICATE 
                                ONLY. FOR COMPLEX ARG FOR VALUE, INCORRECT))
                  (STRPOS%: (* CAN'T TRANSLATE SKIP/ANCHOR/TAIL/CASEARRAY))
                  (SUBLIS%: (* INTERLISP (D)
                               SUBLIS WITH FLG=T ALSO COPIES SUBSTITUTIONS WHICH ARE LISTS. 
                               TRANSFORMATION DOES NOT.))
                  (SUBPAIR%: (* SEE IF PAIRLIS CAN BE MOVED OUT))
                  (SYSTEMTYPE%: (* MANY USES OF SYSTEMTYPE ARE DONE AS SHARP+/- READ MACROS IN CL))
                  [TCONC%: (* NEED (DEFUN TCONC (PTR X)
                                          (LET ((L (LIST X)))
                                               [COND ((NULL PTR)
                                                      (SETQ PTR (LIST NIL]
                                               (COND ((CAR PTR)
                                                      (RPLACD (CDR PTR)
                                                             L))
                                                     (T (RPLACA PTR L)))
                                               (RPLACD PTR L]
                  (TIME%: (* TIMEN AND TIMETYP ARGS NOT SUPPORTED IN CL))
                  (TYPENAMEP%: (* TYPENAMEP DATATYPE NAMES NOT MAPPED))
                  (TYPEP%: (* TYPEP IS ANCIENT INTERLISP-10 TEST ON TYPENUMBER! YOUR PROBLEM IS TO 
                              MAP TYPENUMBER TO CL TYPENAME))
                  (UNDOABLE (* AN UNDOABLE /FN HAS BEEN TRANSFORMED TO ORDINARY COUNTERPART))
                  (UNPACK%: (* UNPACK/CHCON AND SURROUNDING TO SEQUENCE OPERATIONS?? THE TRANSLATION 
                               TO COERCE WILL WORK FOR SYMBOLS AND STRINGS, BUT PRINC-TO-STRING IS 
                               NEEDED FOR MOST OTHER KINDS OF ARGUMENTS))
                  (create%: (* This create can not be translated yet.))
                  (fetch1%: (* OUGHT TO BECOME (AREF DATUM INDEX)
                               where INDEX depends on position of field in record and any skip counts 
                               before it in record))
                  (fetch%: (* OUGHT TO BECOME (AREF DATUM INDEX)
                              where INDEX depends on position of field in record and any skip counts 
                              before it in record))
                  (push%: (* TRANSLATION OF MULTIPLE PUSH GIVES MULTIPLE EVALUATION OF PLACE))
                  (replace1%: (* OUGHT TO BECOME (AREF DATUM INDEX)
                                 where INDEX depends on position of field in record and any skip 
                                 counts before it in record))
                  (replace%: (* OUGHT TO BECOME (SETF (AREF DATUM INDEX)
                                                      NEWVALUE)
                                where INDEX depends on position of field in record and any skip 
                                counts before it in record))))

(RPAQQ NLISTPCOMS
 NIL)

(RPAQQ LAMBDACOMS
 
       [(COMS (SELECTQ (%## 1 1)
                     ([LAMBDA NLAMBDA]
                      '(COMSQ (IF (AND [NOT (EQLENGTH (%## (NTH 2))
                                                   (LENGTH (%## 1 2]
                                       (LISTP (%## 1 2)))
                                  ((REMARK BLAMBDA2))
                                  NIL)
                              MARK
                              (ORR (1 (NTH 3)
                                      DOTHESE)
                                   ((REMARK BLAMBDA3)))
                              __
                              (NTH 2)
                              DOTHESE))
                     '(COMSQ (REMARK BLAMBDA1)
                             (-1 APPLY*])

(RPAQQ TRANSFORMATIONS
 (* *CATCH *THROW /DECLAREDATATYPE /NCONC /NCONC1 /PUTPROP /RPLACA /SETATOMVAL 
                          ADD ADD.PROCESS ADD1 ADDLAST ADDMENU ADDPROP ADDTOVAR ADVISE ALPHORDER 
                          ANTILOG APPEND APPLY* APROPOS ARCCOS ARCSIN ARCTAN ARCTAN2 ARG ARRAY ARRAYP 
                          ASKUSER ASSOC ATOM ATOMRECORD ATTACH ATTACHMENU ATTACHWINDOW BIN BITBLT 
                          BLOCK BOUT BQUOTE BREAK BREAKDOWN BRKDWNRESULTS BYTEPOSITION BYTESIZE 
                          CCODEP CENTERPRINTINREGION CHANGE CHANGEFONT CHARACTER CHARCODE CHCON 
                          CHCON1 CHUNK.MENU.CREATE CLEARW CLISP%  CLISPDEC CLOCK CLOSEF CLOSEF? 
                          CLOSEW CLRPROMPT CNDIR COMPILE CONCAT COND CONS CONSCOUNT CONSTANT 
                          CONSTANTS COPY COPYALL COPYBYTES COPYCHARS COPYREADTABLE COS COUNT 
                          CREATE.NUMBERPAD.READER CREATEREGION CREATEW DATATYPE DATE DECLARE 
                          DECLARE%: DEF DEFINE-FILE-INFO DEFINEQ DEFPRINT DEL.PROCESS DELETEMENU 
                          DELFILE DETACHALLWINDOWS DIFFERENCE DIRECTORYNAME DISMISS DO DREMOVE 
                          DREVERSE DRIBBLE DSPCLIPPINGREGION DSPCREATE DSPFILL DSPFONT DSPRESET 
                          DSPRIGHTMARGIN DSPSCROLL DSPXPOSITION DSPYPOSITION DSUBLIS DSUBST DV 
                          ECHOCONTROL EDITE EDITV ELT EOFP EQLENGTH EQP ERROR ERROR! ERRORSET ERSETQ 
                          EVENP EVERY EXPRP FASSOC FCHARACTER FETCH FIELDLOOK FILECOMS FILECOMSLST 
                          FILENAMEFIELD FILEPKGCHANGES FILESLOAD FINDFILE FIX FIXP FLASHWINDOW FLAST 
                          FLESSP FLOATP FMAX FMEMB FMIN FNTH FNTYP FONTCREATE FONTPROP FOR 
                          FORCEOUTPUT FQUOTIENT FRPLACA FRPLACD FTIMES FUNCTION GEQ GETBOXPOSITION 
                          GETD GETFILEINFO GETFILEPTR GETPROP GETPROPLIST GETPROPMPTWINDOW GETREGION 
                          GETRELATION GETTOPVAL GETWINDOWPROP GIVE.TTY.PROCESS GLOBALVARS GREATERP 
                          HARRAY HARRAYP HARRAYSIZE HASHARRAY HASHARRAYP HASHLINK HELP IDATE 
                          IDIFFERENCE IEQP IGEQ IGREATERP ILEQ ILESSP IMAX IMIN IMINUS IMOD INFILE 
                          INFILECOMTAIL INFILEP INPUT INTEGERLENGTH INTERRUPTCHAR IOFILE IPLUS 
                          IQUOTIENT IREMAINDER ITIMES KWOTE L-CASE LAMBDA LASTC LAYOUTGRAPH 
                          LAYOUTSEXPR LDIFF LDIFFERENCE LENGTH LEQ LESSP LET LET* LISPVERSION LISPX 
                          LISPXPRINT LISPXREAD LISPXREADP LISPXUNREAD LISTFILES1 LISTGET LISTP 
                          LISTPUT LITATOM LLSH LOAD LOAD? LOADFNS LOCALVARS LOGOR LOGOUT LRSH LSH 
                          LSUBST MACHINETYPE MAP MAP2C MAP2CAR MAPC MAPCAR MAPCON MAPCONC MAPHASH 
                          MAPLIST MARKASCHANGED MASTERSCOPE MEMB MEMBER MENU MERGE MINUS MISSPELLED? 
                          MKATOM MKSTRING MOUSECONFIRM MOVETO NCHARS NCONC1 NEQ NEWPRINTDEF NLAMBDA 
                          NLEFT NLISTP NLSETQ NOTANY NOTEVERY NTH NTHCHAR NTHCHARCODE NTYPX NUMBERP 
                          NUMBERPAD.READ ODDP OPENFILE OPENLAMBDA OPENSTREAM OPENW OPENWP OUTFILE 
                          OUTPUT PACK PACK* PACKC PACKFILENAME PEEKC PLUS POSITION PRETTYCOMPRINT 
                          PRIN1 PRIN2 PRIN3 PRINT PRINTBELLS PRINTDEF PRINTNUM PRINTOUT PROCESSP 
                          PROCESSPROP PROG PROGN PROMPTCHAR PROMPTPRINT PUSH PUSHLIST PUSHNEW 
                          PUTASSOC PUTD PUTHASH PUTPROP PUTPROPS QUOTE QUOTIENT RAND RANDSET RATOM 
                          READC READLINE READP READTABLEP READVISE RECLOOK RECORD REGIONP REMOVE 
                          REMPROPLIST REPLACE RESETFORM RESETLST RESETSAVE RESETVAR RESETVARS 
                          RESTART.PROCESS RETFROM RETTO RNUMBER RPAQ RPAQ? RPAQQ RPLNODE RPLNODE2 
                          RPLSTRING RSH SASSOC SCROLLBYREPAINTFN SELECTC SELECTQ SETA SETFILEPTR 
                          SETMENU SETN SETPROPLIST SETQ SETQQ SETSYNTAX SETTOPVAL SHADEITEM SHOULDNT 
                          SHOWGRAPH SHOWZOOMGRAPH SIN SMALLP SOME SORT SPACES SPECVARS SQRT STKEVAL 
                          STKPOS STREQUAL STRINGP STRPOS SUB1 SUBATOM SUBLIS SUBPAIR SUBSET SUBSTRING 
                          SUSPEND.PROCESS SWAP SYSTEMTYPE TAB TAN TCONC TCP.CLOSE.SENDER 
                          TCP.OTHER.STREAM THIS.PROCESS TIME TIMES TOTOPW TTYDISPLAYSTREAM TTYIN 
                          TYPE? TYPENAMEP TYPEP TYPERECORD U-CASE UALPHORDER UNBREAK UNPACK USEREXEC 
                          WFROMMENU WHENCLOSE WHEREIS WHILE WINDOWADDPROP WINDOWP WINDOWPROP XNLSETQ 
                          ZEROP \ADDTOFILEBLOCK/ADDTOCOM1 add addlast change create do fetch ffetch 
                          for freplace pop printout push pushlist pushnew replace swap type? while))

(PUTPROPS * XFORM
 ((1 *COMMENT*)
                   [IF (EQ (%## 2)
                           '*)
                       ((2 ;;))
                       ((IF (GREATERP (LENGTH (%##))
                                   10)
                            ((-2 ;;))
                            ((-2 ;]
                   [I 3 (STRINGIFY (CDDR (%##]
                   (IF (%## (NTH 4))
                       ((DELETE (4 THRU)))
                       NIL)))

(PUTPROPS *CATCH XFORM
 ((1 CATCH)))

(PUTPROPS *THROW XFORM
 ((1 THROW)))

(PUTPROPS /DECLAREDATATYPE XFORM
 ((MBD *)
                                  DOTHIS))

(PUTPROPS /NCONC XFORM
 ((REMARK UNDOABLE)
                        (1 NCONC)))

(PUTPROPS /NCONC1 XFORM
 ((REMARK UNDOABLE)
                         (1 NCONC)
                         (-3 LIST)
                         (LI 3)))

(PUTPROPS /PUTPROP XFORM
 ((REMARK UNDOABLE)
                          (1 SETF)
                          (-2 GET)
                          (BI 2 4)))

(PUTPROPS /RPLACA XFORM
 ((1 RPLACA)
                         (REMARK UNDOABLE)))

(PUTPROPS /SETATOMVAL XFORM
 ((REMARK UNDOABLE)
                             (REMARK /SETATOMVAL%:)
                             (1 SETTOPVAL)
                             DOTHIS))

(PUTPROPS ADD XFORM
 ((1 add)
                     DOTHIS))

(PUTPROPS ADD.PROCESS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ADD1 XFORM
 ((1 1+)))

(PUTPROPS ADDLAST XFORM
 [DW (IF (EQ (CAR (%##))
                                    'CLISP% )
                                (DOTHIS)
                                ((REMARK ADDLAST%:])

(PUTPROPS ADDMENU XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ADDPROP XFORM
 ((1 PUSHNEW GETPROP)
                         (BI 2 4)
                         (SW 2 3)))

(PUTPROPS ADDTOVAR XFORM
 [(IF (%## (NTH 4))
                              ((1 SETQ)
                               (LI 3)
                               (EMBED 3 IN (UNION '&))
                               3
                               (I N (%## 0 2)))
                              ((1 PUSHNEW)
                               (SW 2 3)
                               (EMBED 2 IN QUOTE])

(PUTPROPS ADVISE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ALPHORDER XFORM
 ((1 STRING<)))

(PUTPROPS ANTILOG XFORM
 ((1 EXP)))

(PUTPROPS APPEND XFORM
 [(ORR (3)
                             ((N NIL])

(PUTPROPS APPLY* XFORM
 ((1 FUNCALL)))

(PUTPROPS APROPOS XFORM
 ((IF (EQ (CADDDR (%##))
                                 T)
                             ((1 APROPOS-LIST)
                              (4))
                             NIL)
                         (IF (OR (CADDR (%##))
                                 (CADDDR (%##)))
                             ((REMARK APROPOS%:))
                             NIL)))

(PUTPROPS ARCCOS XFORM
 [(1 ACOS)
                        (IF (%## 3)
                            ((3))
                            ((MBD (TIMES & (/ 180 (FLOAT PI &])

(PUTPROPS ARCSIN XFORM
 [(1 ASIN)
                        (IF (%## 3)
                            ((3))
                            ((MBD (TIMES & (/ 180 (FLOAT PI &])

(PUTPROPS ARCTAN XFORM
 [(1 ATAN)
                        (IF (%## 3)
                            ((3))
                            ((MBD (TIMES & (/ 180 (FLOAT PI &])

(PUTPROPS ARCTAN2 XFORM
 [(1 ATAN)
                         (IF (%## 4)
                             ((4))
                             ((MBD (TIMES & (/ 180 (FLOAT PI &])

(PUTPROPS ARG XFORM
 [(1 NTH)
                     (IF (NUMBERP (%## 3))
                         [(I 3 (SUB1 (%## 3]
                         ((EMBED 3 IN 1-])

(PUTPROPS ARRAY XFORM
 ((1 make-array)
                       (EMBED 2 IN ADD1)
                       (ORR ((5))
                            NIL)
                       (ORR ((3))
                            NIL)
                       (ORR (3 (B :initial-element))
                            NIL)))

(PUTPROPS ARRAYP XFORM
 (TESTORVAL
                        (COMS (SELECTQ USAGE (TEST NIL)
                                     [VALUE '(IF (ATOM (%## 2))
                                                 ((MBD AND)
                                                  (I N (%## 2 2))
                                                  NLAM)
                                                 ([1 FUNCALL (LAMBDA (X)
                                                                    (AND (ARRAYP X)
                                                                         X]
                                                  2 DOTHIS (REMARK NUMBERP1%:]
                                     [UNKNOWN '(COMSQ (REMARK NUMBERP1%:)
                                                      (ORR (2 1)
                                                           ((MBD AND)
                                                            (I N (%## 2 2))
                                                            NLAM]
                                     NIL))))

(PUTPROPS ASKUSER XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ASSOC XFORM
 ((REMARK ASSOC%:)))

(PUTPROPS ATOM XFORM
 ((1 OR)
                      (EMBED 2 IN (SYMBOLP &)
                             (NUMBERP &))
                      (REMARK INTERLISP-ATOM)))

(PUTPROPS ATOMRECORD XFORM
 ((MBD *)
                            DOTHIS))

(PUTPROPS ATTACH XFORM
 [(1 (LAMBDA (X L)
                                  (RPLACD L (CONS (CAR L)
                                                  (CDR L)))
                                  (RPLACA L X])

(PUTPROPS ATTACHMENU XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ATTACHWINDOW XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS BIN XFORM
 ((1 READ-BYTE)))

(PUTPROPS BITBLT XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS BLOCK XFORM
 [(1 SLEEP)
                       (ORR ((EMBED 2 IN (/ & 1000))
                             2 2 DOTHIS)
                            ((N 0])

(PUTPROPS BOUT XFORM
 ((1 WRITE-BYTE)
                      (SW 2 3)))

(PUTPROPS BQUOTE XFORM
 ((LPQ (F \, N)
                             2 DOTHIS)
                        NLAM))

(PUTPROPS BREAK XFORM
 ((REMARK BREAK%:)))

(PUTPROPS BREAKDOWN XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS BRKDWNRESULTS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS BYTEPOSITION XFORM
 ((1 BYTE-POSITION)))

(PUTPROPS BYTESIZE XFORM
 ((1 BYTE-SIZE)))

(PUTPROPS CCODEP XFORM
 ((1 COMPILED-FUNCTION-P)))

(PUTPROPS CENTERPRINTINREGION XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS CHANGE XFORM
 ((1 change)
                        DOTHIS))

(PUTPROPS CHANGEFONT XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS CHARACTER XFORM
 ((MBD INTERN)
                           NLAM))

(PUTPROPS CHARCODE XFORM
 ([I 2 (CL:INT-CHAR (EVAL (%##]
                          (1 CHAR-INT)
                          (REMARK CHARCODE%:)))

(PUTPROPS CHCON XFORM
 ((REMARK UNPACK%:)
                       (1 STRING)
                       (MBD (MAP 'LIST (FUNCTION CHAR-CODE)
                                 &))
                       4 2 DOTHIS))

(PUTPROPS CHCON1 XFORM
 ((1 CHAR)
                        (N 0)
                        (EMBED 2 IN STRING)
                        (MBD CHAR-CODE)))

(PUTPROPS CHUNK.MENU.CREATE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS CLEARW XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS CLISP%  XFORM
 ((IF [OR (MEMB (L-CASE (%## 1))
                                       '(while for push pop pushnew add swap))
                                 (AND (MEMB (%## 1)
                                            DataTypeSpecialForms)
                                      (DataTypeP (%## 2]
                             ((I %: (CDDR (%##)))
                              1 DOTHIS)
                             ((I %: (CADR (%##)))
                              1 DOTHIS))))

(PUTPROPS CLISPDEC XFORM
 ((MBD *)
                          DOTHIS))

(PUTPROPS CLOCK XFORM
 [(COMS (SELECTQ (CADR (%##))
                                    [(0 NIL)
                                     '(COMSQ (1 *)
                                             [ORR (2 (/ 1000 INTERNAL-TIME-UNITS-PER-SECOND)
                                                     (GET-INTERNAL-REAL-TIME))
                                                  ((N (/ 1000 INTERNAL-TIME-UNITS-PER-SECOND)
                                                      (GET-INTERNAL-REAL-TIME]
                                             (REMARK CLOCK%:]
                                    [2 '(COMSQ (1 *)
                                               (2 (/ 1000 INTERNAL-TIME-UNITS-PER-SECOND)
                                                  (GET-INTERNAL-RUN-TIME))
                                               (REMARK CLOCK%:]
                                    '(REMARK CLOCK1%:])

(PUTPROPS CLOSEF XFORM
 ((1 CLOSE)))

(PUTPROPS CLOSEF? XFORM
 ((1 CLOSE)))

(PUTPROPS CLOSEW XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS CLRPROMPT XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS CNDIR XFORM
 ((1 SETQ *DEFAULT-PATHNAME-DEFAULTS*)
                       (EMBED 3 IN PARSE-NAMESTRING)))

(PUTPROPS COMPILE XFORM
 ((REMARK COMPILE%:)))

(PUTPROPS CONCAT XFORM
 ((1 CONCATENATE 'STRING)
                        (NTH 3)
                        DOTHESE 1 (LPQ (IF (STRINGP (%##))
                                           NIL
                                           ((MBD STRING)))
                                       NX)))

(PUTPROPS COND XFORM
 (1 (LPQ NX (ORR DOTHESE NIL))))

(PUTPROPS CONS XFORM
 [(ORR (3)
                           ((ORR (2 (A NIL))
                                 ((N NIL NIL])

(PUTPROPS CONSCOUNT XFORM
 ((1 QUOTE 0)
                           (REMARK CONSCOUNT%:)))

(PUTPROPS CONSTANT XFORM
 ((XTR 2)
                          DOTHIS))

(PUTPROPS CONSTANTS XFORM
 ((1 PROGN)
                           2
                           (LPQ [ORR (2 DOTHIS 0 (-1 DEFCONSTANT))
                                     ((IF (AND (GETTOPVAL (%##))
                                               (NEQ (GETTOPVAL (%##))
                                                    'NOBIND))
                                          [(I MBD (LIST 'DEFCONSTANT '& (KWOTE (GETTOPVAL (%##]
                                          ((MBD DEFCONSTANT)
                                           (REMARK CONSTANTS%:]
                                NX)))

(PUTPROPS COPY XFORM
 ((1 COPY-TREE)))

(PUTPROPS COPYALL XFORM
 ((1 COPY-TREE)
                         (REMARK COPYALL%:)))

(PUTPROPS COPYBYTES XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS COPYCHARS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS COPYREADTABLE XFORM
 ((1 COPY-READTABLE)))

(PUTPROPS COS XFORM
 [(IF (%## 3)
                         ((3))
                         ((EMBED 2 IN (TIMES & (/ (FLOAT PI &)
                                                  180])

(PUTPROPS COUNT XFORM
 ((REMARK COUNT%:)))

(PUTPROPS CREATE.NUMBERPAD.READER XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS CREATEREGION XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS CREATEW XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DATATYPE XFORM
 ((1 DEFSTRUCT)
                          3 1 (LPQ (ORR ((XTR 1))
                                        NIL)
                                   NX)
                          0 0 (NTH 3)
                          [LPQ (IF (%## 2)
                                   ((IF (EQ '_ (%## 3))
                                        ((I EMBED 1 (LIST 'F (%## 2)
                                                          NIL)
                                            1
                                            'IN
                                            (LIST '& (%## 4)))
                                         (BI 2 4)
                                         (2))
                                        ((REMARK RECORD1%:]
                          (BO 1)))

(PUTPROPS DATE XFORM
 ((ORR (2)
                           NIL)
                      (1 MULTIPLE-VALUE-BIND (SEC MIN HR DA MO YR)
                         (GET-DECODED-TIME)
                         (CONCATENATE 'STRING DA "-" (CASE MO (1 "Jan")
                                                           (2 "Feb")
                                                           (3 "Mar")
                                                           (4 "Apr")
                                                           (5 "May")
                                                           (6 "Jun")
                                                           (7 "Jul")
                                                           (8 "Aug")
                                                           (9 "Sep")
                                                           (10 "Oct")
                                                           (11 "Nov")
                                                           (12 "Dec"))
                                "-" YR " " HR ":" MIN ":" SEC))
                      (REMARK DATE%:)
                      NLAM))

(PUTPROPS DECLARE XFORM
 ((IF (EQ (%## 2 1)
                                 'SPECVARS)
                             [(IF (%## 3)
                                  ((REMARK DECLARE%:)
                                   (MBD *)
                                   DOTHIS)
                                  (2 (1 SPECIAL)
                                     (REMARK DECLARE1%:]
                             ((MBD *)
                              DOTHIS))))

(PUTPROPS DECLARE%: XFORM
 ((IF (EQ (%## 2)
                                   'EVAL@COMPILE)
                               ((1 PROGN)
                                (2))
                               ((MBD *)
                                DOTHIS))))

(PUTPROPS DEF XFORM
 ((1 DEFUN)
                     3 MARK DOTHIS __ UP (BO 1)
                     (DELETE 1)
                     NLAM))

(PUTPROPS DEFINE-FILE-INFO XFORM
 ((E (SETREADTABLE (FIND-READTABLE (LISTGET (%## (NTH 2))
                                                                          :READTABLE)))
                                     T)
                                  (E (LISTPUT (%## (NTH 2))
                                            :PACKAGE "XCL")
                                     T)
                                  (E (LISTPUT (%## (NTH 2))
                                            :READTABLE "XCL")
                                     T)))

(PUTPROPS DEFINEQ XFORM
 ((1 PROGN)
                         2
                         (LPQ (-1 DEF)
                              NX)))

(PUTPROPS DEFPRINT XFORM
 ((REMARK DEFPRINT%:)
                          (MBD *)
                          DOTHIS))

(PUTPROPS DEL.PROCESS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DELETEMENU XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DELFILE XFORM
 ((1 DELETE-FILE)))

(PUTPROPS DETACHALLWINDOWS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DIFFERENCE XFORM
 ((1 -)))

(PUTPROPS DIRECTORYNAME XFORM
 [(COMS (SELECTQ (CADR (%##))
                                            [NIL '(%: (USER-HOMEDIR-PATHNAME]
                                            (T '(%: *DEFAULT-PATHNAME-DEFAULTS*))
                                            '(REMARK DIRECTORYNAME%:])

(PUTPROPS DISMISS XFORM
 ((1 SLEEP)
                         (EMBED 2 IN (/ & 1000))
                         2 2 DOTHIS))

(PUTPROPS DO XFORM
 ((-1 for)
                    DOTHIS))

(PUTPROPS DREMOVE XFORM
 
          [(1 DELETE)
           MARK 0 (IF (MEMB (%## 1)
                            '(SETQ REPLACE RPLACA RPLACD replace change PUTPROP SET PUTASSOC 
                                   SETPROPLIST SETTOPVAL))
                      NIL
                      ((REMARK DREMOVE%:])

(PUTPROPS DREVERSE XFORM
 ((1 NREVERSE)))

(PUTPROPS DRIBBLE XFORM
 ((IF (%## (NTH 3))
                             ((REMARK DRIBBLE%:))
                             NIL)))

(PUTPROPS DSPCLIPPINGREGION XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSPCREATE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSPFILL XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSPFONT XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSPRESET XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSPRIGHTMARGIN XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSPSCROLL XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSPXPOSITION XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSPYPOSITION XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS DSUBLIS XFORM
 ((1 NSUBLIS)
                         (ORR ((4)
                               (REMARK SUBLIS%:))
                              NIL)))

(PUTPROPS DSUBST XFORM
 ((1 NSUBST)))

(PUTPROPS DV XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ECHOCONTROL XFORM
 ((1 NILL)))

(PUTPROPS EDITE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS EDITV XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ELT XFORM
 ((1 AREF)))

(PUTPROPS EOFP XFORM
 ((1 =)
                      (EMBED 2 IN (FILE-POSITION &)
                             (FILE-LENGTH &))))

(PUTPROPS EQLENGTH XFORM
 ((EMBED 2 IN LENGTH)
                          (1 =)))

(PUTPROPS EQP XFORM
 ((1 =)))

(PUTPROPS ERROR XFORM
 ((ORR ((4))
                            NIL)
                       (1 CERROR "~a~%%~a")))

(PUTPROPS ERROR! XFORM
 ((1 ABORT)
                        (REMARK ERROR!%:)))

(PUTPROPS ERRORSET XFORM
 ((REMARK ERRORSET%:)))

(PUTPROPS ERSETQ XFORM
 ((1 CATCH-ABORT)
                        (REMARK NLSETQ%:)))

(PUTPROPS EVENP XFORM
 ((ORR (3 0 (1 IMOD)
                               (MBD ZEROP))
                            NIL)))

(PUTPROPS EVERY XFORM
 ([ORR ((IF (%## 4)))
                            (4 'CDR)
                            ((N 'CDR]
                       (I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                                    '[DO (($$TEM1 %#L (APPLY* %#TL $$TEM1)))
                                         ((NOT (CONSP $$TEM1))
                                          T)
                                         (COND ((NOT (APPLY* %#F (CAR $$TEM1)
                                                            $$TEM1))
                                                (RETURN] T))
                       MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                              '(FUNCTION QUOTE))
                                        ((MOVE 2 2 TO %: 1)
                                         (2))
                                        NIL)
                       __))

(PUTPROPS EXPRP XFORM
 ((EMBED 2 IN (FUNCTIONP &)
                              (NOT (COMPILED-FUNCTION-P &)))
                       (1 AND)))

(PUTPROPS FASSOC XFORM
 ((1 ASSOC)))

(PUTPROPS FCHARACTER XFORM
 ((1 CHARACTER)
                            (MBD INTERN)
                            NLAM))

(PUTPROPS FETCH XFORM
 ((1 fetch)
                       DOTHIS))

(PUTPROPS FIELDLOOK XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS FILECOMS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS FILECOMSLST XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS FILENAMEFIELD XFORM
 [(IF (EQ (CAR (CADDR (%##)))
                                       'QUOTE)
                                   [(COMS (SELECTQ (CADR (%## 3))
                                                 [HOST '(COMSQ (1 PATHNAME-HOST)
                                                               (3]
                                                 [DEVICE '(COMSQ (1 PATHNAME-DEVICE)
                                                                 (3]
                                                 [DIRECTORY '(COMSQ (1 PATHNAME-DIRECTORY)
                                                                    (3]
                                                 [NAME '(COMSQ (1 PATHNAME-NAME)
                                                               (3]
                                                 [EXTENSION '(COMSQ (1 PATHNAME-TYPE)
                                                                    (3]
                                                 [VERSION '(COMSQ (1 PATHNAME-VERSION)
                                                                  (3]
                                                 '(REMARK FILENAMEFIELD%:]
                                   ((REMARK FILENAMEFIELD%:])

(PUTPROPS FILEPKGCHANGES XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS FILESLOAD XFORM
 ((-1 *)
                           DOTHIS))

(PUTPROPS FINDFILE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS FIX XFORM
 ((1 TRUNCATE)))

(PUTPROPS FIXP XFORM
 ((1 INTEGERP)
                      TESTORVAL
                      (COMS (SELECTQ USAGE (TEST NIL)
                                   [VALUE '(IF (ATOM (%## 2))
                                               ((MBD AND)
                                                (I N (%## 2 2))
                                                NLAM)
                                               ([1 FUNCALL (LAMBDA (X)
                                                                  (AND (INTEGERP X)
                                                                       X]
                                                2 DOTHIS (REMARK NUMBERP1%:]
                                   [UNKNOWN '(COMSQ (REMARK NUMBERP%:)
                                                    (ORR (2 1)
                                                         ((MBD AND)
                                                          (I N (%## 2 2))
                                                          NLAM]
                                   NIL))))

(PUTPROPS FLASHWINDOW XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS FLAST XFORM
 ((1 LAST)))

(PUTPROPS FLESSP XFORM
 ((1 #:<)))

(PUTPROPS FLOATP XFORM
 (TESTORVAL
                        (COMS (SELECTQ USAGE (TEST NIL)
                                     [VALUE '(IF (ATOM (%## 2))
                                                 ((MBD AND)
                                                  (I N (%## 2 2))
                                                  NLAM)
                                                 ([1 FUNCALL (LAMBDA (X)
                                                                    (AND (FLOATP X)
                                                                         X]
                                                  2 DOTHIS (REMARK NUMBERP1%:]
                                     [UNKNOWN '(COMSQ (REMARK NUMBERP%:)
                                                      (ORR (2 1)
                                                           ((MBD AND)
                                                            (I N (%## 2 2))
                                                            NLAM]
                                     NIL))))

(PUTPROPS FMAX XFORM
 ((1 MAX)))

(PUTPROPS FMEMB XFORM
 ((1 MEMBER)))

(PUTPROPS FMIN XFORM
 ((1 MIN)))

(PUTPROPS FNTH XFORM
 ((1 NTHCDR)
                      (SW 2 3)
                      (EMBED 2 IN 1-)))

(PUTPROPS FNTYP XFORM
 ([EMBED 2 IN (AND (FBOUNDP &)
                                        (NOT (SPECIAL-FORM-P &))
                                        (NOT (MACRO-FUNCTION &]
                       (XTR 2)
                       (REMARK FNTYP%:)))

(PUTPROPS FONTCREATE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS FONTPROP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS FOR XFORM
 ((1 for)
                     DOTHIS))

(PUTPROPS FORCEOUTPUT XFORM
 [(COMS (SELECTQ (CADDR (%##))
                                          [T '(COMSQ (1 FINISH-OUTPUT)
                                                     (3]
                                          (NIL '(1 FORCE-OUTPUT))
                                          '(COMSQ (REMARK FORCEOUTPUT%:)
                                                  (1 FORCE-OUTPUT])

(PUTPROPS FQUOTIENT XFORM
 ((1 /)
                           (EMBED 3 IN FLOAT)))

(PUTPROPS FRPLACA XFORM
 ((1 RPLACA)))

(PUTPROPS FRPLACD XFORM
 ((1 RPLACD)))

(PUTPROPS FTIMES XFORM
 ((1 *)))

(PUTPROPS FUNCTION XFORM
 ((IF (GETPROP (%## 2)
                                     'XFORM)
                              [(REMARK FUNCTION%:)
                               (S ORIGFNNAME 2)
                               (I EMBED 2 'IN (CONS '& (ARGLIST ORIGFNNAME)))
                               MARK 2 DOTHIS __ 2 (IF (EQUAL (%## (NTH 2))
                                                             (ARGLIST ORIGFNNAME))
                                                      ((XTR 1))
                                                      ([MBD (LAMBDA NIL &]
                                                       (I 2 (ARGLIST ORIGFNNAME]
                              NIL)))

(PUTPROPS GEQ XFORM
 ((1 >=)))

(PUTPROPS GETBOXPOSITION XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS GETD XFORM
 ((EMBED 2 IN (FBOUNDP &)
                             (SYMBOL-FUNCTION &))
                      (1 AND)))

(PUTPROPS GETFILEINFO XFORM
 [(IF (EQ (%## 3 1)
                                     'QUOTE)
                                 [(COMS (SELECTQ (%## 3 2)
                                               [WRITEDATE '(COMSQ (1 FILE-WRITE-DATE)
                                                                  (3]
                                               [AUTHOR '(COMSQ (1 FILE-AUTHOR)
                                                               (3]
                                               [LENGTH '(COMSQ (1 FILE-LENGTH)
                                                               (3]
                                               '(REMARK GETFILEINFO%:]
                                 ((REMARK GETFILEINFO%:])

(PUTPROPS GETFILEPTR XFORM
 ((1 FILE-POSITION)))

(PUTPROPS GETPROP XFORM
 ((1 GET)))

(PUTPROPS GETPROPLIST XFORM
 ((1 SYMBOL-PLIST)))

(PUTPROPS GETPROPMPTWINDOW XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS GETREGION XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS GETRELATION XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS GETTOPVAL XFORM
 ((1 SYMBOL-VALUE)))

(PUTPROPS GETWINDOWPROP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS GIVE.TTY.PROCESS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS GLOBALVARS XFORM
 ((1 *)
                            DOTHIS))

(PUTPROPS GREATERP XFORM
 ((1 >)))

(PUTPROPS HARRAY XFORM
 ((1 MAKE-HASH-TABLE :SIZE)))

(PUTPROPS HARRAYP XFORM
 ((1 HASH-TABLE-P)))

(PUTPROPS HARRAYSIZE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS HASHARRAY XFORM
 ((1 MAKE-HASH-TABLE :SIZE)
                           (ORR ((-4 :REHASH-SIZE))
                                NIL)))

(PUTPROPS HASHARRAYP XFORM
 ((1 HASH-TABLE-P)))

(PUTPROPS HASHLINK XFORM
 ((MBD *)
                          DOTHIS))

(PUTPROPS HELP XFORM
 ((1 CERROR "Help ~a~%%~a")))

(PUTPROPS IDATE XFORM
 [(IF (%## 2)
                           ((1 ENCODE-UNIVERSAL-TIME)
                            (REMARK IDATE%:))
                           ((1 GET-UNIVERSAL-TIME])

(PUTPROPS IDIFFERENCE XFORM
 ((1 -)))

(PUTPROPS IEQP XFORM
 ((1 =)))

(PUTPROPS IGEQ XFORM
 ((1 >=)))

(PUTPROPS IGREATERP XFORM
 ((1 >)))

(PUTPROPS ILEQ XFORM
 ((1 <=)))

(PUTPROPS ILESSP XFORM
 ((1 #:<)))

(PUTPROPS IMAX XFORM
 ((1 MAX)))

(PUTPROPS IMIN XFORM
 ((1 MIN)))

(PUTPROPS IMINUS XFORM
 ((1 -)))

(PUTPROPS IMOD XFORM
 ((1 MOD)))

(PUTPROPS INFILE XFORM
 ((EMBED 2 IN (OPENSTREAM & 'INPUT))
                        (1 INPUT)
                        DOTHIS))

(PUTPROPS INFILECOMTAIL XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS INFILEP XFORM
 ((1 PROBE-FILE)))

(PUTPROPS INPUT XFORM
 [(IF (%## 2)
                           ((1 PROG1 *STANDARD-INPUT*)
                            (EMBED 3 IN (SETQ *STANDARD-INPUT* &)))
                           ((%: *STANDARD-INPUT*])

(PUTPROPS INTEGERLENGTH XFORM
 ((1 INTEGER-LENGTH)))

(PUTPROPS INTERRUPTCHAR XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS IOFILE XFORM
 ((1 OPENFILE)
                        (N 'BOTH 'OLD)
                        DOTHIS))

(PUTPROPS IPLUS XFORM
 ((1 +)))

(PUTPROPS IQUOTIENT XFORM
 ((1 TRUNCATE)))

(PUTPROPS IREMAINDER XFORM
 ((1 REMAINDER)))

(PUTPROPS ITIMES XFORM
 ((1 *)))

(PUTPROPS KWOTE XFORM
 ((REMARK KWOTE%:)))

(PUTPROPS L-CASE XFORM
 [(IF (CADDR (%##))
                            ((1 STRING-CAPITALIZE)
                             (3))
                            ((1 STRING-DOWNCASE])

(PUTPROPS LAMBDA XFORM
 ((IF (AND (%## 2)
                                 (LITATOM (%## 2)))
                            ((EMBED 2 IN &REST)
                             (NTH 3)
                             (E (OR (BOUNDP 'LAMNS)
                                    (SETQ LAMNS))
                                T)
                             MARK
                             (E (SETQ UPFINDFLG)
                                T)
                             (E (SETQ LAMNS (CONS (%## 0 2 -1)
                                                  LAMNS))
                                T)
                             (LPQ (I F (CAR LAMNS)
                                     'N)
                                  (IF (EQ (%## BK)
                                          'ARG)
                                      NIL
                                      ((MBD LENGTH)
                                       -1)))
                             (E (SETQ UPFINDFLG T)
                                T)
                             (E (SETQ LAMNS (CDR LAMNS))
                                T)
                             __ DW DOTHESE)
                            (DW (NTH 3)
                                DOTHESE))))

(PUTPROPS LASTC XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS LAYOUTGRAPH XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS LAYOUTSEXPR XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS LDIFF XFORM
 ((ORR (4 0 (MBD NCONC)
                               (MOVE 2 4 TO -2))
                            NIL)
                       (REMARK LDIFF%:)))

(PUTPROPS LDIFFERENCE XFORM
 ((1 SET-DIFFERENCE)))

(PUTPROPS LENGTH XFORM
 ((1 LIST-LENGTH)))

(PUTPROPS LEQ XFORM
 ((1 <=)))

(PUTPROPS LESSP XFORM
 ((1 #:<)))

(PUTPROPS LET XFORM
 (MARK 2 1 (LPQ (IF (OR (LITATOM (%##))
                                           (EQ (%## 1)
                                               (%## 2)))
                                       NIL
                                       (2 DOTHIS 0))
                                   NX)
                          __
                          (NTH 3)
                          DOTHESE))

(PUTPROPS LET* XFORM
 (MARK 2 1 (LPQ (IF (OR (LITATOM (%##))
                                            (EQ (%## 1)
                                                (%## 2)))
                                        NIL
                                        (2 DOTHIS 0))
                                    NX)
                           __
                           (NTH 3)
                           DOTHESE))

(PUTPROPS LISPVERSION XFORM
 ((1 LISP-IMPLEMENTATION-VERSION)))

(PUTPROPS LISPX XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS LISPXPRINT XFORM
 ((1 PRINT)
                            (ORR ((5))
                                 NIL)
                            DOTHIS))

(PUTPROPS LISPXREAD XFORM
 ((1 READ)))

(PUTPROPS LISPXREADP XFORM
 ((1 READP)
                            (REMARK READP%:)))

(PUTPROPS LISPXUNREAD XFORM
 ((REMARK LISPXUNREAD%:)
                             (%:)))

(PUTPROPS LISTFILES1 XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS LISTGET XFORM
 ((1 GETF)))

(PUTPROPS LISTP XFORM
 ((1 CONSP)
                       TESTORVAL
                       (COMS (SELECTQ USAGE (TEST NIL)
                                    [VALUE '(IF (ATOM (%## 2))
                                                ((MBD AND)
                                                 (I N (%## 2 2)))
                                                ([1 FUNCALL (LAMBDA (X)
                                                                   (AND (CONSP X)
                                                                        X]
                                                 (REMARK LISTP%:]
                                    [UNKNOWN '(COMSQ (REMARK LISTP1%:)
                                                     (ORR (2 1)
                                                          ((MBD AND)
                                                           (I N (%## 2 2]
                                    NIL))))

(PUTPROPS LISTPUT XFORM
 ((1 SETF LISTGET)
                         (BI 2 4)))

(PUTPROPS LITATOM XFORM
 ((1 SYMBOLP)))

(PUTPROPS LLSH XFORM
 ((1 *)
                      (EMBED 3 IN (EXPT 2 &))))

(PUTPROPS LOAD XFORM
 ((ORR ((-4 :VERBOSE))
                           NIL)
                      (ORR (3 (ORR ((IF (%##))
                                    (REMARK LOAD%:))
                                   NIL)
                              (%:))
                           NIL)))

(PUTPROPS LOAD? XFORM
 ((1 LOAD)
                       DOTHIS
                       (REMARK LOAD?%:)))

(PUTPROPS LOADFNS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS LOCALVARS XFORM
 ((MBD *)
                           DOTHIS))

(PUTPROPS LOGOR XFORM
 ((1 LOGIOR)))

(PUTPROPS LOGOUT XFORM
 ((1 EXIT)
                        (REMARK LOGOUT%:)))

(PUTPROPS LRSH XFORM
 [(1 LDB)
                      (SW 2 3)
                      (I 2 (LIST 'BYTE [COND ((NUMBERP (%## 2))
                                              (DIFFERENCE 32 (%## 2)))
                                             (T (LIST '- 32 (%## 2]
                                 (%## 2])

(PUTPROPS LSH XFORM
 ((1 ASH)))

(PUTPROPS LSUBST XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS MACHINETYPE XFORM
 ((1 MACHINE-TYPE)))

(PUTPROPS MAP XFORM
 [(1 MAPL)
                     (IF (%## 4)
                         ((I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                                       '(DO (($$TEM1 %#L (APPLY* %#TL $$TEM1)))
                                            (NOT (CONSP $$TEM1))
                                            (APPLY* %#F $$TEM1)) T))
                          MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                                 '(FUNCTION QUOTE))
                                           ((MOVE 2 2 TO %: 1)
                                            (2))
                                           NIL)
                          __)
                         ((SW 2 3])

(PUTPROPS MAP2C XFORM
 [(IF (%## 5)
                           ((REMARK MAP2C%:))
                           ((1 MAPC)
                            (MOVE 4 TO B 2])

(PUTPROPS MAP2CAR XFORM
 [(IF (%## 5)
                             ((REMARK MAP2C%:))
                             ((1 MAPCAR)
                              (MOVE 4 TO B 2])

(PUTPROPS MAPC XFORM
 [(IF (%## 4)
                          ((I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                                        '(DO (($$TEM1 %#L (APPLY* %#TL $$TEM1)))
                                             (NOT (CONSP $$TEM1))
                                             (APPLY* %#F (CAR $$TEM1))) T))
                           MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                                  '(FUNCTION QUOTE))
                                            ((MOVE 2 2 TO %: 1)
                                             (2))
                                            NIL)
                           __)
                          ((SW 2 3])

(PUTPROPS MAPCAR XFORM
 
          [(IF (%## 4)
               ((I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                             '[DO (($$TEM1 %#L (APPLY* %#TL $$TEM1))
                                   ($$VAL)
                                   ($$TEM3)
                                   ($$TEM2))
                                  ((NOT (CONSP $$TEM1))
                                   $$VAL)
                                  (SETQ $$TEM3 (APPLY* %#F (CAR $$TEM1)))
                                  (COND [$$TEM2 (RPLACD $$TEM2 (SETQ $$TEM2 (LIST $$TEM3]
                                        (T (SETQ $$VAL (SETQ $$TEM2 (LIST $$TEM3] T))
                MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                       '(FUNCTION QUOTE))
                                 ((MOVE 2 2 TO %: 1)
                                  (2))
                                 NIL)
                __)
               ((SW 2 3])

(PUTPROPS MAPCON XFORM
 [(IF (%## 4)
                            ((I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                                          '[DO (($$TEM1 %#L (APPLY* %#TL $$TEM1))
                                                ($$VAL))
                                               ((NOT (CONSP $$TEM1))
                                                $$VAL)
                                               (SETQ $$VAL (NCONC $$VAL (APPLY* %#F $$TEM1] T))
                             MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                                    '(FUNCTION QUOTE))
                                              ((MOVE 2 2 TO %: 1)
                                               (2))
                                              NIL)
                             __)
                            ((SW 2 3])

(PUTPROPS MAPCONC XFORM
 
          [(IF (%## 4)
               ((I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                             '[DO (($$TEM1 %#L (APPLY* %#TL $$TEM1))
                                   ($$VAL))
                                  ((NOT (CONSP $$TEM1))
                                   $$VAL)
                                  (SETQ $$VAL (NCONC $$VAL (APPLY* %#F (CAR $$TEM1] T))
                MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                       '(FUNCTION QUOTE))
                                 ((MOVE 2 2 TO %: 1)
                                  (2))
                                 NIL)
                __)
               ((SW 2 3)
                (1 MAPCAN])

(PUTPROPS MAPHASH XFORM
 ((SW 2 3)
                         2
                         [IF (%## 2 2)
                             (2 2 (SW 1 2))
                             ((MBD (FUNCTION (LAMBDA (X Y)
                                                    (APPLY* & Y X]
                         0))

(PUTPROPS MAPLIST XFORM
 
          [(IF (%## 4)
               ((I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                             '[DO (($$TEM1 %#L (APPLY* %#TL $$TEM1))
                                   ($$VAL)
                                   ($$TEM3)
                                   ($$TEM2))
                                  ((NOT (CONSP $$TEM1))
                                   $$VAL)
                                  (SETQ $$TEM3 (APPLY* %#F $$TEM1))
                                  (COND [$$TEM2 (RPLACD $$TEM2 (SETQ $$TEM2 (LIST $$TEM3]
                                        (T (SETQ $$VAL (SETQ $$TEM2 (LIST $$TEM3] T))
                MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                       '(FUNCTION QUOTE))
                                 ((MOVE 2 2 TO %: 1)
                                  (2))
                                 NIL)
                __)
               ((SW 2 3])

(PUTPROPS MARKASCHANGED XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS MASTERSCOPE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS MEMB XFORM
 ((1 MEMBER)))

(PUTPROPS MEMBER XFORM
 ((N :TEST (FUNCTION EQUAL))))

(PUTPROPS MENU XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS MERGE XFORM
 [(-2 'LIST)
                       (IF (%## 5)
                           ((IF (EQ (%## 5)
                                    T)
                                [(5 (FUNCTION (LAMBDA (A B)
                                                     (STRING< (CAR A)
                                                            (CAR B]
                                NIL))
                           ((N 'STRING<])

(PUTPROPS MINUS XFORM
 ((1 -)))

(PUTPROPS MISSPELLED? XFORM
 ((XTR 2)))

(PUTPROPS MKATOM XFORM
 ((1 string)
                        (MBD INTERN)))

(PUTPROPS MKSTRING XFORM
 [(IF (%## (NTH 3))
                              ((1 PRIN1-TO-STRING)
                               (3)
                               (IF (%## 3)
                                   ((REMARK MKSTRING%:))
                                   NIL))
                              ((1 PRINC-TO-STRING])

(PUTPROPS MOUSECONFIRM XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS MOVETO XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS NCHARS XFORM
 ((1 LENGTH)
                        (EMBED 2 IN STRING)))

(PUTPROPS NCONC1 XFORM
 ((1 NCONC)
                        (-3 LIST)
                        (LI 3)))

(PUTPROPS NEQ XFORM
 ((1 EQ)
                     (MBD NOT)))

(PUTPROPS NEWPRINTDEF XFORM
 ((1 PRINTDEF)
                             DOTHIS))

(PUTPROPS NLAMBDA XFORM
 ((REMARK NLAMBDA%:)
                         (NTH 3)
                         DW DOTHESE))

(PUTPROPS NLEFT XFORM
 (MARK (NTH 2)
                            DOTHESE __
                            [I %: (SUBPAIR '(%#L %#N %#TAIL) (%## (NTH 2))
                                         '(LET ((LTEMP %#L)
                                                (TAILTEMP %#TAIL))
                                               (DO ((LTAIL LTEMP (CDR LTAIL))
                                                    (TAILTAIL (NTHCDR LTEMP N)
                                                           (CDR TAILTAIL)))
                                                   ((EQL TAILTAIL TAILTEMP)
                                                    LTAIL]
                            (REMARK NLEFT%:)))

(PUTPROPS NLISTP XFORM
 ((1 ATOM)))

(PUTPROPS NLSETQ XFORM
 ((1 CATCH-ABORT)
                        (NTH 2)
                        DOTHESE 0 (MBD (HANDLER-CASE & (ERROR NIL NIL)))
                        (REMARK NLSETQ%:)))

(PUTPROPS NOTANY XFORM
 [(IF (%## 4)
                            ((1 SOME)
                             (MBD NOT))
                            ((SW 2 3])

(PUTPROPS NOTEVERY XFORM
 ((1 EVERY)
                          (MBD NOT)))

(PUTPROPS NTH XFORM
 [(1 NTHCDR)
                     (SW 2 3)
                     (IF (NUMBERP (%## 2))
                         [(I 2 (SUB1 (%## 2]
                         ((EMBED 2 IN 1-])

(PUTPROPS NTHCHAR XFORM
 ((1 AREF)
                         (EMBED 2 IN STRING)
                         (EMBED 3 IN 1-)
                         (IF (%## (NTH 4))
                             ((REMARK NTHCHAR%:))
                             NIL)))

(PUTPROPS NTHCHARCODE XFORM
 ((1 AREF)
                             (EMBED 2 IN STRING)
                             (EMBED 3 IN 1-)
                             (IF (%## (NTH 4))
                                 ((REMARK NTHCHAR%:))
                                 NIL)
                             (MBD CHAR-CODE)))

(PUTPROPS NTYPX XFORM
 ((REMARK NTYPX%:)))

(PUTPROPS NUMBERP XFORM
 
          (TESTORVAL (COMS (SELECTQ USAGE (TEST NIL)
                                  [VALUE '(IF (ATOM (%## 2))
                                              ((MBD AND)
                                               (I N (%## 2 2))
                                               NLAM)
                                              ([1 FUNCALL (LAMBDA (X)
                                                                 (AND (NUMBERP X)
                                                                      X]
                                               2 DOTHIS (REMARK NUMBERP1%:]
                                  [UNKNOWN '(COMSQ (REMARK NUMBERP%:)
                                                   (ORR (2 1)
                                                        ((MBD AND)
                                                         (I N (%## 2 2))
                                                         NLAM]
                                  NIL))))

(PUTPROPS NUMBERPAD.READ XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ODDP XFORM
 ((ORR [3 0 (1 IMOD)
                              (MBD (NOT (ZEROP &]
                           NIL)))

(PUTPROPS OPENFILE XFORM
 
          [(1 OPEN)
           (-3 :DIRECTION)
           (I 4 (SELECTQ (%## 4 2)
                       (INPUT :INPUT)
                       (OUTPUT :OUTPUT)
                       (BOTH :IO)
                       (APPEND :APPEND)
                       (%## 4)))
           (ORR (6 (REMARK OPENFILE1%:)
                   0
                   (6))
                NIL)
           (ORR (5 0)
                ((N NIL)))
           (IF (EQUAL (%## 5)
                      ''OLDEST)
               ((REMARK OPENFILE2%:)
                (5 'OLD))
               NIL)
           (IF (EQ (%## 4)
                   :APPEND)
               ((N :IF-EXISTS :APPEND)
                (IF (EQUAL (%## 5)
                           ''OLD)
                    ((5))
                    ((5 :IF-DOES-NOT-EXIST :CREATE)))
                (4 :OUTPUT))
               ((COMS (SELECTQ (%## 5)
                             (NEW '(5 :IF-EXISTS :NEW-VERSION))
                             (OLD '(5 :IF-EXISTS :OVERWRITE))
                             (OLD/NEW '(5 :IF-EXISTS :OVERWRITE :IF-DOES-NOT-EXIST :CREATE))
                             '(COMS (SELECTQ (%## 4)
                                           (:OUTPUT '(5 :IF-EXISTS :NEW-VERSION))
                                           (:INPUT '(5))
                                           '(5 :IF-EXISTS :OVERWRITE :IF-DOES-NOT-EXIST :CREATE])

(PUTPROPS OPENLAMBDA XFORM
 (DW))

(PUTPROPS OPENSTREAM XFORM
 ((1 OPENFILE)
                            DOTHIS))

(PUTPROPS OPENW XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS OPENWP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS OUTFILE XFORM
 [(IF (%## 2)
                             ((ORR [(EMBED 2 IN (OPENSTREAM & 'OUTPUT]
                                   NIL)
                              (1 OUTPUT)
                              DOTHIS)
                             ((%: *STANDARD-OUTPUT*])

(PUTPROPS OUTPUT XFORM
 [(IF (%## 2)
                            ((1 PROG1 *STANDARD-OUTPUT*)
                             (EMBED 3 IN (SETQ *STANDARD-OUTPUT* &)))
                            ((%: *STANDARD-OUTPUT*])

(PUTPROPS PACK XFORM
 (2 DOTHIS (MBD (APPLY (FUNCTION CONCATENATE)
                                           'STRING
                                           (MAPCAR (FUNCTION STRING)
                                                  &)))
                        0
                        (1 INTERN)
                        (REMARK UNPACK%:)))

(PUTPROPS PACK* XFORM
 ((1 CONCAT)
                       (MBD INTERN)))

(PUTPROPS PACKC XFORM
 ((1 CL:MAP 'STRING (FUNCTION CHARACTER))
                       (MBD INTERN)
                       2 4 DOTHIS))

(PUTPROPS PACKFILENAME XFORM
 ((1 MAKE-PATHNAME)
                              (LPQ (IF (EQ (%## 2 1)
                                           'QUOTE)
                                       ((COMS (SELECTQ (%## 2 2)
                                                     (HOST '(2 :HOST))
                                                     (DEVICE '(2 :DEVICE))
                                                     (DIRECTORY '(2 :DIRECTORY))
                                                     (NAME '(2 :NAME))
                                                     (EXTENSION '(2 :TYPE))
                                                     (VERSION '(2 :VERSION))
                                                     [BODY '(COMSQ (2 :DEFAULTS)
                                                                   (REMARK PACKFILENAME%:]
                                                     NIL)))
                                       ((ORR (2 (REMARK PACKFILENAME1%:)
                                                0)
                                             NIL)))
                                   3 UP)))

(PUTPROPS PEEKC XFORM
 ((1 PEEK-CHAR)
                       (ORR (2 (B NIL))
                            NIL)))

(PUTPROPS PLUS XFORM
 ((1 +)))

(PUTPROPS POSITION XFORM
 ((REMARK POSITION%:)))

(PUTPROPS PRETTYCOMPRINT XFORM
 ((MBD *)
                                DOTHIS))

(PUTPROPS PRIN1 XFORM
 ((1 PRINC)))

(PUTPROPS PRIN2 XFORM
 ((1 PRIN1)))

(PUTPROPS PRIN3 XFORM
 ((1 PRINC)))

(PUTPROPS PRINT XFORM
 [P (IF (CDDR (%##))
                             [(IF (LITATOM (%## 3))
                                  [(1 PRINC)
                                   (MBD PROGN)
                                   (I N (LIST 'TERPRI (%## 2 3]
                                  ([1 (LAMBDA (OBJ &OPTIONAL FILE)
                                             (PRIN1 OBJ FILE)
                                             (TERPRI FILE)
                                             OBJ]
                                   (NTH 2)
                                   DOTHESE
                                   (REMARK PRINT%:]
                             ((1 PRINC)
                              (MBD PROGN)
                              (N (TERPRI])

(PUTPROPS PRINTBELLS XFORM
 ((1 PRINC "")))

(PUTPROPS PRINTDEF XFORM
 ((1 WRITE)
                          (ORR (3 (IF (%##)
                                      ((REMARK PRINTDEF%:))
                                      NIL)
                                  (%:)
                                  0)
                               NIL)
                          (ORR ((3))
                               NIL)
                          (ORR (3 (IF (%##)
                                      ((REMARK PRINTDEF%:))
                                      NIL)
                                  (%:)
                                  0)
                               NIL)
                          (ORR ((3))
                               NIL)
                          (ORR (3 (B :STREAM)
                                  0)
                               NIL)
                          (N :PRETTY T)))

(PUTPROPS PRINTNUM XFORM
 
          [(IF (EQ (%## 2 1)
                   'QUOTE)
               [(COMS (SELECTQ (%## 2 2 1)
                             [FIX '(COMSQ (I 2 (CONCAT "~"
                                                      (COND ((MEMB (CADDR (%## 2 2))
                                                                   '(10 8 2 16 NIL))
                                                             "")
                                                            ((NUMBERP (%## 2 2 3))
                                                             (CONCAT (%## 2 2 3)
                                                                    ","))
                                                            (T (SHOULDNT)))
                                                      (COND ((NUMBERP (CADR (%## 2 2)))
                                                             (%## 2 2 2))
                                                            (T ""))
                                                      (COND ((CADDDR (%## 2 2))
                                                             ",'0")
                                                            (T ""))
                                                      (SELECTQ (CADDR (%## 2 2))
                                                             ((NIL 10)
                                                              "D")
                                                             (8 "O")
                                                             (2 "B")
                                                             (16 "X")
                                                             "R")))
                                          (1 FORMAT)
                                          (IF (%## (NTH 4))
                                              ((MOVE 4 TO B 2))
                                              ((-2 NIL)))
                                          (COMS (SELECTQ (%## 2)
                                                       (NIL '(2 T))
                                                       (T '(2 *TERMINAL-IO*))
                                                       NIL]
                             [FLOAT '(COMSQ (I 2 (CONCAT "~" (COND ((CADR (%## 2 2))
                                                                    (%## 2 2 2)))
                                                        ","
                                                        (COND ((CADDR (%## 2 2))
                                                               (%## 2 2 3))
                                                              (T ""))
                                                        (SELECTQ (CADDDR (%## 2 2))
                                                               ((NIL 0)
                                                                "")
                                                               (CONCAT "," (%## 2 2 4)))
                                                        (COND ((CAR (CDDDDR (%## 2 2)))
                                                               ",,,'0")
                                                              (T ""))
                                                        (SELECTQ (CADDDR (%## 2 2))
                                                               ((NIL 0)
                                                                "F")
                                                               "E")))
                                            (1 FORMAT)
                                            (IF (%## (NTH 4))
                                                ((MOVE 4 TO B 2))
                                                ((-2 NIL)))
                                            (COMS (SELECTQ (%## 2)
                                                         (NIL '(2 T))
                                                         (T '(2 *TERMINAL-IO*))
                                                         NIL]
                             '(COMSQ (1 PRINC)
                                     (2)
                                     (REMARK PRINTNUM%:]
               (((1 PRINC)
                 (2)
                 (REMARK PRINTNUM%:])

(PUTPROPS PRINTOUT XFORM
 ((1 printout)
                          DOTHIS))

(PUTPROPS PROCESSP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS PROCESSPROP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS PROG XFORM
 (MARK 2 1 (LPQ (IF (OR (LITATOM (%##))
                                            (EQ (%## 1)
                                                (%## 2)))
                                        NIL
                                        (2 DOTHIS 0))
                                    NX)
                           __
                           (NTH 3)
                           DOTHESE))

(PUTPROPS PROGN XFORM
 ((ORR (3)
                            ((XTR 2)
                             DOTHIS)
                            NIL)))

(PUTPROPS PROMPTCHAR XFORM
 ((1 PRINC)))

(PUTPROPS PROMPTPRINT XFORM
 ((1 PRINT)
                             DOTHIS
                             (REMARK PROMPTPRINT%:)))

(PUTPROPS PUSH XFORM
 ((1 push)
                      DOTHIS))

(PUTPROPS PUSHLIST XFORM
 ((1 pushlist)
                          DOTHIS))

(PUTPROPS PUSHNEW XFORM
 ((1 pushnew)
                         DOTHIS))

(PUTPROPS PUTASSOC XFORM
 ((REMARK PUTASSOC%:)))

(PUTPROPS PUTD XFORM
 ((1 SETF)
                      (EMBED 2 IN SYMBOL-FUNCTION)))

(PUTPROPS PUTHASH XFORM
 ((1 SETF GETHASH)
                         (SW 4 5)
                         (BI 2 4)))

(PUTPROPS PUTPROP XFORM
 ((1 SETF GET)
                         (BI 2 4)))

(PUTPROPS PUTPROPS XFORM
 
          ((IF
            (EQ 'MACRO (%## 3))
            [(1 DEFMACRO)
             (3)
             (ORR [(BO 3)
                   (NTH 4)
                   DW DOTHESE !0
                   (COMS (SELECTQ (%## 3)
                                [NIL '(COMSQ (ORR (5 0 (EMBED (4 THRU)
                                                              IN PROGN))
                                                  NIL)
                                             (EMBED 4 IN QUOTE]
                                [[LAMBDA OPENLAMBDA]
                                 '(COMSQ (-3 (&REST ACTUAL))
                                         (IF (EQ (%## 4)
                                                 'OPENLAMBDA)
                                             ((4 LAMBDA))
                                             NIL)
                                         (LI 4)
                                         (EMBED 4 IN `(& ,@ACTUAL]
                                [NLAMBDA '(REMARK PUTPROPS%:]
                                (COND [(LISTP (%## 3))
                                       '(COMSQ (ORR (5 0 (EMBED (4 THRU)
                                                                IN PROGN))
                                                    NIL)
                                               (EMBED 4 IN `&)
                                               (I 4 (SUBPAIR (%## 3)
                                                           [MAPCAR (%## 3)
                                                                  (FUNCTION (LAMBDA
                                                                             (X)
                                                                             (LIST '\, X]
                                                           (%## 4)
                                                           T]
                                      ((LITATOM (%## 3))
                                       '(EMBED 3 IN &REST))
                                      (T '(REMARK PUTPROPS1%:]
                  ((IF (EQ (%## 3 1)
                           '=)
                       [(I 3 '(&REST ACTUAL) (LIST 'BQUOTE (CDR (%## 3))
                                                   '%,@ACTUAL]
                       NIL]
            ((1 PUTPROP)
             (EMBED 2 IN QUOTE)
             (EMBED 3 IN QUOTE)
             (EMBED 4 IN QUOTE)
             DOTHIS))))

(PUTPROPS QUOTE XFORM
 (NLAM))

(PUTPROPS QUOTIENT XFORM
 ((1 /)))

(PUTPROPS RAND XFORM
 [(1 RANDOM)
                      (IF (ZEROP (%## 2))
                          [(2)
                           (IF (NUMBERP (%## 2))
                               ((IF (FIXP (%## 2))
                                    [(I 2 (PLUS 1 (%## 2]
                                    NIL))
                               ((REMARK RAND%:]
                          ((MBD +)
                           (INSERT (%## 2 2)
                                  BEFORE 2)
                           3
                           (SW 2 3)
                           (-2 -)
                           (LI 2)
                           2
                           (IF (AND (NUMBERP (%## 2))
                                    (NUMBERP (%## 3)))
                               [(IF (AND (FIXP (%## 2))
                                         (FIXP (%## 3)))
                                    [(I %: (PLUS 1 (DIFFERENCE (%## 2)
                                                          (%## 3]
                                    ((I %: (DIFFERENCE (%## 2)
                                                  (%## 3]
                               ((IF (OR (FLOATP (%## 2))
                                        (FLOATP (%## 3)))
                                    NIL
                                    ((REMARK RAND%:])

(PUTPROPS RANDSET XFORM
 [(1 MAKE-RANDOM-STATE)
                         (MBD (PROG1 *RANDOM-STATE* (SETQ *RANDOM-STATE* &])

(PUTPROPS RATOM XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS READC XFORM
 ((1 READ-CHAR)))

(PUTPROPS READLINE XFORM
 ((1 READ-LINE)))

(PUTPROPS READP XFORM
 ((1 LISTEN)))

(PUTPROPS READTABLEP XFORM
 
          (TESTORVAL (COMS (SELECTQ USAGE (TEST NIL)
                                  [VALUE '(IF (ATOM (%## 2))
                                              ((MBD AND)
                                               (I N (%## 2 2))
                                               NLAM)
                                              ([1 FUNCALL (LAMBDA (X)
                                                                 (AND (READTABLEP X)
                                                                      X]
                                               2 DOTHIS (REMARK NUMBERP1%:]
                                  [UNKNOWN '(COMSQ (REMARK NUMBERP1%:)
                                                   (ORR (2 1)
                                                        ((MBD AND)
                                                         (I N (%## 2 2))
                                                         NLAM]
                                  NIL))))

(PUTPROPS READVISE XFORM
 ((REMARK READVISE%:)))

(PUTPROPS RECLOOK XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS RECORD XFORM
 
          ((IF [NULL (CDR (LAST (%## 3]
               [(1 DEFSTRUCT)
                (NTH 3)
                [LPQ (IF (%## 2)
                         ((IF (EQ '_ (%## 3))
                              ((I EMBED 1 (LIST 'F (%## 2)
                                                NIL)
                                  1
                                  'IN
                                  (LIST '& (%## 4)))
                               (BI 2 4)
                               (2))
                              ((REMARK RECORD1%:]
                (BO 1)
                0
                (E (CLISP%  ([LAMBDA ($$1)
                                    (COND ((FMEMB $$1 XlatedRecords)
                                           XlatedRecords)
                                          (T (SETQ XlatedRecords (CONS $$1 XlatedRecords]
                             (%## 2))
                          pushnew XlatedRecords (%## 2))
                   T)
                (EMBED 2 IN (& (:TYPE LIST]
               ((MBD *)
                DOTHIS))))

(PUTPROPS REGIONP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS REMOVE XFORM
 ((N :TEST (FUNCTION EQUAL))))

(PUTPROPS REMPROPLIST XFORM
 [(NTH 2)
                             DOTHESE 0 (I %: (SUBPAIR '(ATM PROPS) (%## (NTH 2))
                                                    '(DO ((ATTM ATM)
                                                          (PROPC PROPS (CDR PROPC)))
                                                         ((NOT (CONSP PROPC)))
                                                         (REMPROP ATTM (CAR (PROPC])

(PUTPROPS REPLACE XFORM
 ((1 replace)
                         DOTHIS))

(PUTPROPS RESETFORM XFORM
 [(1 LET)
                           (NTH 2)
                           DOTHESE 0 (EMBED 2 IN ((OLD-VALUE &)))
                           (IF (CDR (%## (NTH 3)))
                               [(EMBED (3 THRU)
                                       IN
                                       (UNWIND-PROTECT (PROGN &]
                               ((EMBED 3 IN UNWIND-PROTECT)))
                           3
                           (I N (LIST (%## 0 2 1 2 1)
                                      'OLD-VALUE])

(PUTPROPS RESETLST XFORM
 [(NTH 2)
                          DOTHESE 0 [EMBED (2 THRU)
                                           IN
                                           (UNWIND-PROTECT
                                            (PROGN &)
                                            (DO ((RESETZ *RESETFORMS* (CDR RESETZ))
                                                 OLDVALUE)
                                                ((NULL RESETZ))
                                                (DECLARE (SPECIAL OLDVALUE))
                                                (COND ((CONSP (CAAR RESETZ))
                                                       (SETQ OLDVALUE (IF (CDAR RESETZ)
                                                                          (CADAR RESETZ)
                                                                          (CADAAR RESETZ)))
                                                       (APPLY (CAAAR RESETZ)
                                                              (CDAAR RESETZ)))
                                                      (T (SETF (SYMBOL-VALUE (CAAR RESETZ))
                                                               (CDAR RESETZ]
                          (1 LET (*RESETFORMS*)
                             (DECLARE (SPECIAL *RESETFORMS*])

(PUTPROPS RESETSAVE XFORM
 [(1 PUSH)
                           (N *RESETFORMS*)
                           (IF (LITATOM (%## 2))
                               (3 DOTHIS (MBD (SETF (SYMBOL-VALUE 'X)
                                                    &))
                                  0
                                  (INSERT (%## 2)
                                         FOR 3 2 2)
                                  [EMBED 2 IN (CONS '& (SYMBOL-VALUE '&]
                                  (EMBED (2 THRU 3)
                                         IN PROG1))
                               (2 DOTHIS 0 (IF (%## 4)
                                               ((SW 2 3)
                                                2 DOTHIS 0 (EMBED (2 THRU 3)
                                                                  IN LIST))
                                               ((EMBED 2 IN (LIST (LIST '& &)))
                                                2 2 2 2 (IF (EQ (%## 1)
                                                                'SETQ)
                                                            ((XTR 3 1))
                                                            ((XTR 1])

(PUTPROPS RESETVAR XFORM
 [(1 LET)
                          (NTH 3)
                          DOTHESE 0 (-2 PROGN SETQ)
                          (BI 3 5)
                          (LI 2)
                          (EMBED 2 IN UNWIND-PROTECT)
                          [I -2 (LIST (LIST 'OLD-VALUE (%## 2 2 2 2]
                          3
                          (I N (LIST 'SETQ (%## 2 2 2)
                                     'OLD-VALUE])

(PUTPROPS RESETVARS XFORM
 ((1 LET)
                           (NTH 3)
                           DOTHESE 0 MARK 2 1 (LPQ (IF (OR (LITATOM (%##))
                                                           (EQ (%## 1)
                                                               (%## 2)))
                                                       NIL
                                                       (2 DOTHIS 0))
                                                   NX)
                           __
                           (-3 PROGN (PSETQ))
                           (LI 3)
                           3 2 [I N (CLISP%  [MAPCONC (%## 0 0 2)
                                                    (FUNCTION (LAMBDA (IV)
                                                                     (COND ((LISTP IV)
                                                                            (LIST (CAR IV)
                                                                                  (CADR IV)))
                                                                           (T (LIST IV NIL]
                                           for IV in (%## 0 0 2)
                                           join
                                           (COND ((LISTP IV)
                                                  (LIST (CAR IV)
                                                        (CADR IV)))
                                                 (T (LIST IV NIL]
                           (BO -1)
                           0 0 [I N (CONS 'SETQ (CLISP%  (PROG (($$LST1 (%## 2))
                                                                $$VAL IV (I 1))
                                                               $$LP
                                                               [SETQ IV (CAR (OR (LISTP $$LST1)
                                                                                 (GO $$OUT]
                                                               [SETQ
                                                                $$VAL
                                                                (NCONC $$VAL
                                                                       (LIST (COND ((LISTP IV)
                                                                                    (CAR IV))
                                                                                   (T IV))
                                                                             (PACK* 'OLD-VALUE- I]
                                                               $$ITERATE
                                                               (SETQ $$LST1 (CDR $$LST1))
                                                               (SETQ I (PLUS I 1))
                                                               (GO $$LP)
                                                               $$OUT
                                                               (RETURN $$VAL))
                                                       for IV in (%## 2)
                                                       as I from 1 join (LIST (COND ((LISTP IV)
                                                                                     (CAR IV))
                                                                                    (T IV))
                                                                              (PACK* 'OLD-VALUE- I]
                           (EMBED (3 THRU)
                                  IN UNWIND-PROTECT)
                           [I 2 (CLISP%  (PROG (($$LST1 (%## 2))
                                                $$VAL $$TEM2 $$TEM1 IV (I 1))
                                               $$LP
                                               [SETQ IV (CAR (OR (LISTP $$LST1)
                                                                 (GO $$OUT]
                                               [SETQ $$TEM1 (LIST (PACK* 'OLD-VALUE- I)
                                                                  (COND ((LISTP IV)
                                                                         (CAR IV))
                                                                        (T IV]
                                               [COND [$$TEM2 (FRPLACD $$TEM2 (SETQ $$TEM2
                                                                                   (LIST $$TEM1]
                                                     (T (SETQ $$VAL (SETQ $$TEM2 (LIST $$TEM1]
                                               $$ITERATE
                                               (SETQ $$LST1 (CDR $$LST1))
                                               (SETQ I (PLUS I 1))
                                               (GO $$LP)
                                               $$OUT
                                               (RETURN $$VAL))
                                       for IV in (%## 2)
                                       as I from 1 collect (LIST (PACK* 'OLD-VALUE- I)
                                                                 (COND ((LISTP IV)
                                                                        (CAR IV))
                                                                       (T IV]
                           NLAM))

(PUTPROPS RESTART.PROCESS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS RETFROM XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS RETTO XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS RNUMBER XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS RPAQ XFORM
 ((1 DEFPARAMETER)))

(PUTPROPS RPAQ? XFORM
 [(1 DEFVAR)
                       (ORR (3 DOTHIS)
                            ((N NIL])

(PUTPROPS RPAQQ XFORM
 ((1 DEFPARAMETER)
                       (EMBED 3 IN QUOTE)
                       NLAM))

(PUTPROPS RPLNODE XFORM
 ((1 RPLACD RPLACA)
                         (BI 2 4)))

(PUTPROPS RPLNODE2 XFORM
 [(1 (LAMBDA (X Y)
                                    (RPLACA X (CAR Y))
                                    (RPLACD X (CDR Y])

(PUTPROPS RPLSTRING XFORM
 ((1 REPLACE)
                           (SW 3 4)
                           (-4 :START1)))

(PUTPROPS RSH XFORM
 ((1 ASH)
                     (EMBED 3 IN -)))

(PUTPROPS SASSOC XFORM
 ((1 ASSOC)
                        (N %:TEST %#'EQUAL)))

(PUTPROPS SCROLLBYREPAINTFN XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS SELECTC XFORM
 ((REMARK SELECTC2%:)
                         2 MARK DOTHIS __ (LPQ NX MARK (IF (%## NX UP)
                                                           (DOTHESE)
                                                           (DOTHIS))
                                               __)))

(PUTPROPS SELECTQ XFORM
 ((1 CASE)
                         2 MARK DOTHIS __ (LPQ NX MARK (IF (%## NX UP)
                                                           ((IF (CDR (%##))
                                                                ((NTH 2)
                                                                 DOTHESE 0)
                                                                NIL))
                                                           ((MBD OTHERWISE)
                                                            2 DOTHIS 0))
                                               __)))

(PUTPROPS SETA XFORM
 ((1 SETF AREF)
                      (BI 2 4)))

(PUTPROPS SETFILEPTR XFORM
 ((1 FILE-POSITION)))

(PUTPROPS SETMENU XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS SETN XFORM
 ((1 SETQ)
                      (REMARK SETN%:)))

(PUTPROPS SETPROPLIST XFORM
 ((1 SETF)
                             (EMBED 2 IN SYMBOL-PLIST)))

(PUTPROPS SETQ XFORM
 [(ORR (3)
                           ((N NIL])

(PUTPROPS SETQQ XFORM
 ((1 SETQ)
                       (ORR ((EMBED 3 IN QUOTE))
                            ((N NIL)))
                       NLAM))

(PUTPROPS SETSYNTAX XFORM
 ((REMARK SETSYNTAX%:)))

(PUTPROPS SETTOPVAL XFORM
 ((1 SETF)
                           (EMBED 2 IN SYMBOL-VALUE)))

(PUTPROPS SHADEITEM XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS SHOULDNT XFORM
 ((1 CERROR "SHOULDN'T HAPPEN")))

(PUTPROPS SHOWGRAPH XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS SHOWZOOMGRAPH XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS SIN XFORM
 [(IF (%## 3)
                         ((3))
                         ((EMBED 2 IN (TIMES & (/ (FLOAT PI &)
                                                  180])

(PUTPROPS SMALLP XFORM
 ((1 TYPEP)
                        (N 'FIXNUM)
                        (REMARK SMALLP%:)))

(PUTPROPS SOME XFORM
 
          (TESTORVAL (IF (AND (NULL (CADDDR (%##)))
                              (EQ USAGE 'TEST))
                         ((SW 2 3))
                         ([ORR ((IF (%## 4)))
                               (4 'CDR)
                               ((N 'CDR]
                          (I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                                       '[DO (($$TEM1 %#L (APPLY* %#TL $$TEM1)))
                                            ((NOT (CONSP $$TEM1))
                                             NIL)
                                            (COND ((APPLY* %#F (CAR $$TEM1))
                                                   (RETURN $$TEM1] T))
                          MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                                 '(FUNCTION QUOTE))
                                           ((MOVE 2 2 TO %: 1)
                                            (2))
                                           NIL)
                          __))))

(PUTPROPS SORT XFORM
 [(IF (%## 3)
                          ((IF (EQ (%## 3)
                                   T)
                               [(3 (FUNCTION (LAMBDA (A B)
                                                    (STRING< (CAR A)
                                                           (CAR B]
                               NIL))
                          ((N (FUNCTION STRING<])

(PUTPROPS SPACES XFORM
 [(1 FORMAT)
                        (IF (CDR (%##))
                            ((IF (NULL (%## 2))
                                 ((2 1))
                                 NIL)
                             (ORR (3 0)
                                  ((N NIL)))
                             (SW 2 3)
                             (IF (NUMBERP (%## 3))
                                 ((I 3 (CONCAT "~" (%## 3)
                                              "@T")))
                                 ((-3 "~V@T")))
                             (COMS (SELECTQ (%## 2)
                                          (NIL '(2 T))
                                          (T '(2 *TERMINAL-IO*))
                                          NIL)))
                            ((N T "~@T"])

(PUTPROPS SPECVARS XFORM
 ((1 PROCLAIM)
                          (EMBED (2 THRU)
                                 IN
                                 '(SPECIAL &))
                          NLAM))

(PUTPROPS SQRT XFORM
 ((REMARK SQRT%:)))

(PUTPROPS STKEVAL XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS STKPOS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS STREQUAL XFORM
 ((1 string=)))

(PUTPROPS STRINGP XFORM
 
          (TESTORVAL (COMS (SELECTQ USAGE (TEST NIL)
                                  [VALUE '(IF (ATOM (%## 2))
                                              ((MBD AND)
                                               (I N (%## 2 2))
                                               NLAM)
                                              ([1 FUNCALL (LAMBDA (X)
                                                                 (AND (STRINGP X)
                                                                      X]
                                               2 DOTHIS (REMARK STRINGP1%:]
                                  [UNKNOWN %' (COMSQ (REMARK STRINGP%:)
                                                     (ORR (2 1)
                                                          ((MBD AND)
                                                           (I N (%## 2 2))
                                                           NLAM]
                                  NIL))))

(PUTPROPS STRPOS XFORM
 ((1 SEARCH)
                        (IF (OR (%## 5)
                                (%## 6)
                                (%## 7)
                                (%## 8))
                            ((REMARK STRPOS%:))
                            NIL)
                        (ORR (9 (MBD 1-)
                                (B :START2)
                                0
                                (DELETE (5 THRU 8)))
                             NIL)))

(PUTPROPS SUB1 XFORM
 ((1 1-)))

(PUTPROPS SUBATOM XFORM
 ((1 SUBSTRING)
                         DOTHIS
                         (MBD INTERN)))

(PUTPROPS SUBLIS XFORM
 ((ORR (4 (%:)
                                0
                                (EMBED 3 IN COPY)
                                (REMARK SUBLIS%:))
                             NIL)))

(PUTPROPS SUBPAIR XFORM
 ((1 SUBLIS)
                         (-2 PAIRLIS)
                         (BI 2 4)
                         DOTHIS
                         (REMARK SUBPAIR%:)))

(PUTPROPS SUBSET XFORM
 ([ORR ((IF (%## 4)))
                             (4 'CDR)
                             ((N 'CDR]
                        (I %: (SUBPAIR '(%#L %#F %#TL) (%## (NTH 2))
                                     '[DO (($$TEM1 %#L (APPLY* %#TL $$TEM1))
                                           ($$VAL)
                                           ($$TEM2))
                                          ((NOT (CONSP $$TEM1))
                                           $$VAL)
                                          (COND ((APPLY* %#F (CAR $$TEM1))
                                                 (COND [$$TEM2 (RPLACD $$TEM2 (SETQ
                                                                               $$TEM2
                                                                               (LIST (CAR $$TEM1]
                                                       (T (SETQ $$VAL (SETQ $$TEM2
                                                                            (LIST (CAR $$TEM1] T))
                        MARK 1 2 1 3 (IF (MEMB (%## 2 1)
                                               '(FUNCTION QUOTE))
                                         ((MOVE 2 2 TO %: 1)
                                          (2))
                                         NIL)
                        __))

(PUTPROPS SUBSTRING XFORM
 ((1 SUBSEQ)
                           (EMBED 3 IN 1-)
                           (ORR (4 (MBD 1-))
                                NIL)))

(PUTPROPS SUSPEND.PROCESS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS SWAP XFORM
 ((1 swap)
                      DOTHIS))

(PUTPROPS SYSTEMTYPE XFORM
 ((1 LISP-IMPLEMENTATION-TYPE)
                            (REMARK SYSTEMTYPE%:)))

(PUTPROPS TAB XFORM
 ((1 FORMAT)
                     (ORR (4 0 (MOVE 4 TO B 2))
                          ((-2 NIL)))
                     (ORR (4 0)
                          ((N 1)))
                     (COMS (SELECTQ (%## 2)
                                  (NIL '(2 T))
                                  (T '(2 *TERMINAL-IO*))
                                  NIL))
                     (I -3 (CONCAT "~" (OR (NUMBERP (%## 3))
                                           "V")
                                  ","
                                  (OR (NUMBERP (OR (%## 4)
                                                   1))
                                      "V")
                                  "T"))
                     (IF (NUMBERP (OR (%## 5)
                                      1))
                         ((5))
                         NIL)
                     (IF (NUMBERP (%## 4))
                         ((4))
                         NIL)))

(PUTPROPS TAN XFORM
 [(IF (%## 3)
                         ((3))
                         ((EMBED 2 IN (TIMES & (/ (FLOAT PI &)
                                                  180])

(PUTPROPS TCONC XFORM
 ((REMARK TCONC%:)))

(PUTPROPS TCP.CLOSE.SENDER XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS TCP.OTHER.STREAM XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS THIS.PROCESS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS TIME XFORM
 ((ORR (3 (REMARK TIME%:))
                           NIL)))

(PUTPROPS TIMES XFORM
 ((1 *)))

(PUTPROPS TOTOPW XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS TTYDISPLAYSTREAM XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS TTYIN XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS TYPE? XFORM
 ((1 type?)
                       DOTHIS))

(PUTPROPS TYPENAMEP XFORM
 ((1 TYPEP)))

(PUTPROPS TYPEP XFORM
 ((REMARK TYPEP%:)))

(PUTPROPS TYPERECORD XFORM
 
          ((IF [NULL (CDR (LAST (%## 3]
               ((1 DEFSTRUCT)
                (NTH 3)
                [LPQ (IF (%## 2)
                         ((IF (EQ '_ (%## 3))
                              ((I EMBED 1 (LIST 'F (%## 2)
                                                NIL)
                                  1
                                  'IN
                                  (LIST '& (%## 4)))
                               (BI 2 4)
                               (2))
                              ((REMARK RECORD1%:]
                (BO 1)
                0
                (E (pushnew XlatedRecords (%## 2))
                   T)
                (EMBED 2 IN (& (:TYPE LIST)
                               :NAMED)))
               ((MBD *)
                DOTHIS))))

(PUTPROPS U-CASE XFORM
 ((1 STRING-UPCASE)))

(PUTPROPS UALPHORDER XFORM
 ((1 STRING-LESSP)))

(PUTPROPS UNBREAK XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS UNPACK XFORM
 ((1 STRING)
                        (MBD (COERCE & 'LIST))
                        (REMARK UNPACK%:)))

(PUTPROPS USEREXEC XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS WFROMMENU XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS WHENCLOSE XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS WHEREIS XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS WHILE XFORM
 ((1 while)
                       DOTHIS))

(PUTPROPS WINDOWADDPROP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS WINDOWP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS WINDOWPROP XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS XNLSETQ XFORM
 ((REMARK OUTSIDE-CL%:)))

(PUTPROPS ZEROP XFORM
 ((1 = 0)))

(PUTPROPS \ADDTOFILEBLOCK/ADDTOCOM1 XFORM
 ((REMARK OUTSIDE-CL%:)
                                           DELETE \ADDTOFILEBLOLCK/ADDTOCOM1))

(PUTPROPS add XFORM
 [(IF (%## 4)
                         ((EMBED (3 THRU)
                                 IN PLUS)
                          (1 INCF))
                         ((IF (NUMBERP (%## 3))
                              [(IF (MINUSP (%## 3))
                                   [(1 DECF)
                                    (I 3 (MINUS (%## 3]
                                   ((1 INCF]
                              ((IF (AND (LISTP (%## 3))
                                        (EQ (%## 3 1)
                                            'MINUS))
                                   ((1 DECF)
                                    3
                                    (XTR 2)
                                    0)
                                   ((1 INCF])

(PUTPROPS addlast XFORM
 ((1 ADDLAST)
                         DOTHIS))

(PUTPROPS change XFORM
 [DW (IF (EQ (CAR (%##))
                                   'CLISP% )
                               (DOTHIS)
                               ((REMARK ADDLAST%:])

(PUTPROPS create XFORM
 
          [(IF
            (OR (MEMB 'using (%##))
                (MEMB 'USING (%##)))
            [(COMS (SELECTQ (CAR (RECLOOK (%## 2)))
                          [(RECORD TYPERECORD)
                           (COND [(MEMB (%## 2)
                                        XlatedRecords)
                                  '(COMSQ (F (*ANY* using USING)
                                             NIL)
                                          (1 $$TEMP)
                                          (BI 1 2)
                                          0
                                          (MOVE ($$TEMP &)
                                                TO -1)
                                          (I EMBED 1 2 'IN (PACK* "COPY-" (%## 3)))
                                          MARK 1 2 DOTHIS __ (BI 1)
                                          (-1 LET)
                                          (3)
                                          (N $$TEMP)
                                          (NTH 3)
                                          [LPQ (IF (EQ '_ (%## 3))
                                                   ((I 2 (PACK* (%## 1)
                                                                "-"
                                                                (%## 2)))
                                                    (3 $$TEMP)
                                                    (BI 2 3)
                                                    (-2 SETF)
                                                    MARK 4 DOTHIS __ (BI 2 4)
                                                    (MOVE 2 TO -1)
                                                    (NTH 2))
                                                   ((NTH 3)
                                                    (REMARK create%:]
                                          (1]
                                 (T '(COMSQ (REMARK DATATYPES)
                                            DW
                                            (IF (EQ 'CLISP%  (CAR (%##)))
                                                ((I %: (CADR (%##)))
                                                 1 DOTHIS)
                                                NIL]
                          [DATATYPE '(COMSQ (F (*ANY* using USING)
                                               NIL)
                                            (1 $$TEMP)
                                            (BI 1 2)
                                            0
                                            (MOVE ($$TEMP &)
                                                  TO -1)
                                            (I EMBED 1 2 'IN (PACK* "COPY-" (%## 3)))
                                            MARK 1 2 DOTHIS __ (BI 1)
                                            (-1 LET)
                                            (3)
                                            (N $$TEMP)
                                            (NTH 3)
                                            [LPQ (IF (EQ '_ (%## 3))
                                                     ((I 2 (PACK* (%## 1)
                                                                  "-"
                                                                  (%## 2)))
                                                      (3 $$TEMP)
                                                      (BI 2 3)
                                                      (-2 SETF)
                                                      MARK 4 DOTHIS __ (BI 2 4)
                                                      (MOVE 2 TO -1)
                                                      (NTH 2))
                                                     ((NTH 3)
                                                      (REMARK create%:]
                                            (1]
                          '(COMSQ (REMARK DATATYPES)
                                  DW
                                  (IF (EQ 'CLISP%  (CAR (%##)))
                                      ((I %: (CADR (%##)))
                                       1 DOTHIS)
                                      NIL]
            ((COMS
              (SELECTQ (CAR (RECLOOK (%## 2)))
                     [(RECORD TYPERECORD)
                      (COND [(MEMB (%## 2)
                                   XlatedRecords)
                             '(COMSQ (I 1 (PACK* "MAKE-" (%## 2)))
                                     (DELETE 2)
                                     (NTH 2)
                                     (LPQ (IF (EQ '_ (%## 2))
                                              ((I 1 (CL:INTERN (CONCAT (%## 1))
                                                           (CL:FIND-PACKAGE "KEYWORD")))
                                               (DELETE 2)
                                               (NTH 2)
                                               (IF (LISTP (%## 1))
                                                   (MARK 1 DOTHIS __)
                                                   NIL)
                                               (NTH 2))
                                              ((NTH 3)
                                               (REMARK create%:]
                            (T '(COMSQ (REMARK DATATYPES)
                                       DW
                                       (IF (EQ 'CLISP%  (CAR (%##)))
                                           ((I %: (CADR (%##)))
                                            1 DOTHIS)
                                           NIL]
                     [DATATYPE '(COMSQ (I 1 (PACK* "MAKE-" (%## 2)))
                                       (DELETE 2)
                                       (NTH 2)
                                       (LPQ (IF (EQ '_ (%## 2))
                                                ((I 1 (CL:INTERN (CONCAT (%## 1))
                                                             (CL:FIND-PACKAGE "KEYWORD")))
                                                 (DELETE 2)
                                                 (NTH 2)
                                                 (IF (LISTP (%## 1))
                                                     (MARK 1 DOTHIS __)
                                                     NIL)
                                                 (NTH 2))
                                                ((NTH 3)
                                                 (REMARK create%:]
                     '(COMSQ (REMARK DATATYPES)
                             DW
                             (IF (EQ 'CLISP%  (CAR (%##)))
                                 ((I %: (CADR (%##)))
                                  1 DOTHIS)
                                 NIL])

(PUTPROPS do XFORM
 ((-1 for)
                    DOTHIS))

(PUTPROPS fetch XFORM
 
          [(IF (LISTP (%## 2))
               [(COMS (SELECTQ (CAR (RECLOOK (%## 2 1)))
                             [(RECORD TYPERECORD)
                              (COND [(MEMB (%## 2 1)
                                           XlatedRecords)
                                     '(COMSQ [I 1 (PACK* (CAR (%## 2))
                                                         "-"
                                                         (CADR (%## 2]
                                             (3)
                                             (2]
                                    (T '(COMSQ (REMARK DATATYPES)
                                               DW
                                               (IF (EQ 'CLISP%  (CAR (%##)))
                                                   ((I %: (CADR (%##)))
                                                    1 DOTHIS)
                                                   NIL]
                             [DATATYPE '(COMSQ [I 1 (PACK* (CAR (%## 2))
                                                           "-"
                                                           (CADR (%## 2]
                                               (3)
                                               (2]
                             [ASSOCRECORD '(COMSQ (1 ASSOC)
                                                  (3)
                                                  2
                                                  (1 QUOTE]
                             [ATOMRECORD '(COMSQ (1 GET)
                                                 (3)
                                                 (SW 2 3)
                                                 3
                                                 (1 QUOTE]
                             (ARRAYRECORD '(REMARK fetch%:))
                             [HASHLINK '(COMSQ (1 GETHASH)
                                               (3)
                                               (SW 2 3)
                                               (I 3 (OR [CADADR (CDR (RECLOOK (%## 2 1]
                                                        SYSHASHARRAY]
                             [ACCESSFNS '(COMSQ [I 1 (CADR (ASSOC (%## 2 2)
                                                                  (CADDR (RECLOOK (%## 2 1]
                                                (3)
                                                (2]
                             '(COMSQ (REMARK DATATYPES)
                                     DW
                                     (IF (EQ 'CLISP%  (CAR (%##)))
                                         ((I %: (CADR (%##)))
                                          1 DOTHIS)
                                         NIL]
               ((COMS (SELECTQ (CAAR (FIELDLOOK (%## 2)))
                             [(RECORD TYPERECORD)
                              (COND [(MEMB (CADR (FIELDLOOK (%## 2)))
                                           XlatedRecords)
                                     '(COMSQ (I 1 (PACK* (CADAR (FIELDLOOK (%## 2)))
                                                         "-"
                                                         (%## 2)))
                                             (3)
                                             (2]
                                    (T '(COMSQ (REMARK DATATYPES)
                                               DW
                                               (IF (EQ 'CLISP%  (CAR (%##)))
                                                   ((I %: (CADR (%##)))
                                                    1 DOTHIS)
                                                   NIL]
                             [DATATYPE '(COMSQ (I 1 (PACK* (CADAR (FIELDLOOK (%## 2)))
                                                           "-"
                                                           (%## 2)))
                                               (3)
                                               (2]
                             [ASSOCRECORD '(COMSQ (1 ASSOC)
                                                  (3)
                                                  (EMBED 2 IN QUOTE]
                             [ATOMRECORD '(COMSQ (1 GET)
                                                 (3)
                                                 (SW 2 3)
                                                 (EMBED 3 IN QUOTE]
                             (ARRAYRECORD '(REMARK fetch%:))
                             [HASHLINK '(COMSQ (1 GETHASH)
                                               (3)
                                               (SW 2 3)
                                               (I 3 (OR [CADADR (CDAR (FIELDLOOK (%## 2]
                                                        SYSHASHARRAY]
                             [ACCESSFNS '(COMSQ [I 1 (CADR (ASSOC (%## 2 2)
                                                                  (CADDAR (FIELDLOOK (%## 2]
                                                (3)
                                                (2]
                             '(COMSQ (REMARK DATATYPES)
                                     DW
                                     (IF (EQ 'CLISP%  (CAR (%##)))
                                         ((I %: (CADR (%##)))
                                          1 DOTHIS)
                                         NIL])

(PUTPROPS ffetch XFORM
 ((1 fetch)
                        DOTHIS))

(PUTPROPS for XFORM
 
          (MARK
           (NTH 2)
           DOTHESE __
           (IF (OR (MEMB 'BIND (%##))
                   (MEMB 'bind (%##)))
               (MARK (F (*ANY* BIND bind)
                        NIL)
                     2
                     [LPQ (IF [OR [AND (LITATOM (%##))
                                       (NOT (EQ 'FORWORD (CAR (GETPROP (%##)
                                                                     'CLISPWORD]
                                  (AND (LISTP (%##))
                                       (EQ (%## 2)
                                           '_)
                                       (RPLACD (%##)
                                              (CDDR (%##]
                              ((ORR (NX)
                                    (UP (N **BindMarker**)
                                        2 NX]
                     UP
                     (IF (NOT (EQ (CADR (%##))
                                  '**BindMarker**))
                         ((-1 **BindMarker**))
                         NIL)
                     0
                     (EMBED (((*ANY* BIND bind)
                              NX)
                             THRU **BindMarker**)
                            IN)
                     (F (*ANY* BIND bind)
                        NIL)
                     NX
                     (DELETE -1)
                     __)
               NIL)))

(PUTPROPS freplace XFORM
 ((1 replace)
                          DOTHIS))

(PUTPROPS pop XFORM
 ((1 POP)))

(PUTPROPS printout XFORM
 ((1 FORMAT)
                          (COMS (SELECTQ (%## 2)
                                       (NIL '(2 T))
                                       (T '(2 *TERMINAL-IO*))
                                       NIL))
                          (LI 3)
                          (I 3 (COMPUTEFORMATS (%## 3)))
                          (BO 3)
                          (NTH 2)
                          DOTHESE))

(PUTPROPS push XFORM
 [(IF (%## 4)
                          ((IF (LITATOM (%## 2))
                               NIL
                               ((REMARK push%:)))
                           (-1 LET (($TEMP)))
                           (MOVE 5 TO A 2 1 1)
                           (LI 3)
                           (N (push $TEMP))
                           (INSERT (%## 3 2)
                                  BEFORE 4 2)
                           DOTHIS)
                          ((1 PUSH)
                           (SW 2 3])

(PUTPROPS pushlist XFORM
 [DW (IF (EQ (CAR (%##))
                                     'CLISP% )
                                 (DOTHIS)
                                 ((REMARK ADDLAST%:])

(PUTPROPS pushnew XFORM
 ((1 PUSHNEW)
                         (SW 2 3)))

(PUTPROPS replace XFORM
 
          [(IF (LISTP (%## 2))
               [(COMS (SELECTQ (CAR (RECLOOK (%## 2 1)))
                             [(RECORD TYPERECORD)
                              (if (MEMB (%## 2 1)
                                        XlatedRecords)
                                  then
                                  '(COMSQ (1 SETF)
                                          (I 2 (LIST (PACK* (CAR (%## 2))
                                                            "-"
                                                            (CADR (%## 2)))
                                                     (%## 4)))
                                          (DELETE (3 THRU 5))) else
                                  '(COMSQ (REMARK DATATYPES)
                                          DW
                                          (IF (EQ 'CLISP%  (CAR (%##)))
                                              ((I %: (CADR (%##)))
                                               1 DOTHIS)
                                              NIL]
                             [DATATYPE '(COMSQ (1 SETF)
                                               (I 2 (LIST (PACK* (CAR (%## 2))
                                                                 "-"
                                                                 (CADR (%## 2)))
                                                          (%## 4)))
                                               (DELETE (3 THRU 5]
                             [ASSOCRECORD '(COMSQ (1 SETF ASSOC)
                                                  (6)
                                                  (4)
                                                  (BI 2 4)
                                                  2 2 (1 QUOTE]
                             [ATOMRECORD '(COMSQ (1 SETF GET)
                                                 (6)
                                                 (4)
                                                 (SW 3 4)
                                                 (BI 2 4)
                                                 2 3 (1 QUOTE]
                             (ARRAYRECORD '(REMARK replace%:))
                             [HASHLINK '(COMSQ (1 SETF GETHASH)
                                               (6)
                                               (4)
                                               (SW 3 4)
                                               (I 4 (OR [CADADR (CDR (RECLOOK (%## 3 1]
                                                        SYSHASHARRAY))
                                               (BI 2 4]
                             [ACCESSFNS '(COMSQ [I 1 (CADDR (ASSOC (%## 2 2)
                                                                   (CADDR (RECLOOK (%## 2 1]
                                                (5)
                                                (3)
                                                (2]
                             '(COMSQ (REMARK DATATYPES)
                                     DW
                                     (IF (EQ 'CLISP%  (CAR (%##)))
                                         ((I %: (CADR (%##)))
                                          1 DOTHIS)
                                         NIL]
               ((COMS (SELECTQ (CAAR (FIELDLOOK (%## 2)))
                             [(RECORD TYPERECORD)
                              (COND [(MEMB (CADR (FIELDLOOK (%## 2)))
                                           XlatedRecords)
                                     '(COMSQ (1 SETF)
                                             (I 2 (LIST (PACK* (CADAR (FIELDLOOK (%## 2)))
                                                               "-"
                                                               (%## 2))
                                                        (%## 4)))
                                             (DELETE (3 THRU 5]
                                    (T '(COMSQ (REMARK DATATYPES)
                                               DW
                                               (IF (EQ 'CLISP%  (CAR (%##)))
                                                   ((I %: (CADR (%##)))
                                                    1 DOTHIS)
                                                   NIL]
                             [DATATYPE '(COMSQ (1 SETF)
                                               (I 2 (LIST (PACK* (CADAR (FIELDLOOK (%## 2)))
                                                                 "-"
                                                                 (%## 2))
                                                          (%## 4)))
                                               (DELETE (3 THRU 5]
                             [ASSOCRECORD '(COMSQ (1 SETF ASSOC)
                                                  (6)
                                                  (4)
                                                  (EMBED 3 IN QUOTE)
                                                  (BI 2 4]
                             [ATOMRECORD '(COMSQ (1 SETF GET)
                                                 (6)
                                                 (4)
                                                 (SW 3 4)
                                                 (EMBED 4 IN QUOTE)
                                                 (BI 2 4]
                             (ARRAYRECORD '(REMARK replace%:))
                             [HASHLINK '(COMSQ (1 SETF GETHASH)
                                               (6)
                                               (4)
                                               (SW 3 4)
                                               (I 4 (OR [CADADR (CDAR (FIELDLOOK (%## 3]
                                                        SYSHASHARRAY))
                                               (BI 2 4]
                             [ACCESSFNS '(COMSQ [I 1 (CADDR (ASSOC (%## 2 2)
                                                                   (CADDAR (FIELDLOOK (%## 2]
                                                (3)
                                                (2]
                             '(COMSQ (REMARK DATATYPES)
                                     DW
                                     (IF (EQ 'CLISP%  (CAR (%##)))
                                         ((I %: (CADR (%##)))
                                          1 DOTHIS)
                                         NIL])

(PUTPROPS swap XFORM
 [(IF (AND (LITATOM (%## 1))
                               (LITATOM (%## 2)))
                          ((1 PSETQ)
                           (I N (%## 3)
                              (%## 2)))
                          (DW (IF (EQ (CAR (%##))
                                      'CLISP% )
                                  ((I %: (CADR (%##)))
                                   1 DOTHIS)
                                  ((REMARK ADDLAST%:])

(PUTPROPS type? XFORM
 ((SW 2 3)
                       (EMBED 3 IN QUOTE)
                       (1 TYPEP)))

(PUTPROPS while XFORM
 ((-1 for)
                       DOTHIS))
[COND [(EQ (EVALV 'MERGE)
           T)
       [RPAQ TRANSFORMATIONS (UNION TRANSFORMATIONS (LISTP (GETP 'TRANSFORMATIONS 'VALUE]
       (MAPC (GETP 'USERNOTES 'VALUE)
             (FUNCTION (LAMBDA (NOTE)
                              (OR (ASSOC (CAR NOTE)
                                         USERNOTES)
                                  (SETQ USERNOTES (CONS NOTE USERNOTES]
      (T (MAPC (GETP 'TRANSFORMATIONS 'VALUE)
               (FUNCTION (LAMBDA (X)
                                (AND (NOT (MEMB X TRANSFORMATONS))
                                     (/REMPROP X 'XFORM]

(PUTPROPS TO-COMMONLISP MAKEFILE-ENVIRONMENT
 (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))

(PUTPROPS TO-COMMONLISP.XFORMS MAKEFILE-ENVIRONMENT
 (:READTABLE "INTERLISP" :PACKAGE "INTERLISP"))
(PUTPROPS TO-COMMONLISP.XFORMS COPYRIGHT ("System Development Corp." 1987 1988))
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (5216 14316 (COMPUTEFORMATS 5226 . 11896) (MAKELAMPROG 11898 . 12727) (DataTypeP 12729
 . 13422) (STRINGIFY 13424 . 14314)))))
STOP
ÿ