Start to clean out envos test directory

internal/test/Maiko/AUTO/OPCODES.TEST.~1~

@@ -1,705 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "26-Oct-88 19:11:04" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;4
 30102  
-
-      |changes| |to:|  (TESTS BITBLT-DIAGONALS BITBLT-SLOPED-LINES COPY.N STORE.N POP.N UNWIND 
-                              UNWIND-2 FINDKEY RESTLIST CLOSURES)
-                       (VARS OPCODESCOMS)
-
-      |previous| |date:| "21-Oct-88 17:34:38" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;3)
-
-
-; Copyright (c) 1988 by ENVOS Corporation.  All rights reserved.
-
-(PRETTYCOMPRINT OPCODESCOMS)
-
-(RPAQQ OPCODESCOMS
 (
-                        (* |;;| 
-
                      "This le contains tests for the various opcodes used in the system.")

-
-                        (VARS (*TEST-FILE-NAME* "OPCODES"))
-                        (ADDVARS (DIRECTORIES {ERIS}<TEST>MAIKO>AUX>))
-                        (FILES OPTESTS BBTESTS)
-                        (COMS                                (* \; "BITBLT")

-                              (TESTS BITBLT-DIAGONALS BITBLT-SLOPED-LINES))
-                        (COMS                                (* \; "COPY.N")

-                              (TESTS COPY.N COPY.N-UFN))
-                        (COMS                                (* \; "STORE.N")

-                              (TESTS STORE.N STORE.N-UFN))
-                        (COMS                                (* \; "POP.N")

-                              (TESTS POP.N POP.N-UFN))
-                        (COMS                                (* \; "UNWIND")

-                              (TESTS UNWIND-OFF-BY-1-A UNWIND-OFF-BY-1-B)
-                              (FNS UNWINDTESTER UNWINDMAINTEST UNWINDMAINTEST.RECURSE UNWINDCHECK1 
-                                   UNWINDCHECK2 UNWINDCODE)
-                              (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS BINDMARKSLOT))
-                              (FNS UW2.TEST UW2.RECURSE UW2.TEST.MAIN UW2.CHECK UW2.IDENTITY)
-                              (TESTS UNWIND UNWIND-2))
-                        (COMS                                (* \; "FINDKEY")

-                              (FNS FINDKEYTESTER DOFINDKEYTEST DOFINDKEYTEST1)
-                              (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS FINDKEYCHECK))
-                              (TESTS FINDKEY))
-                        (COMS                                (* \; "RESTLIST")

-                              (FNS \\RESTLIST.SPLICE.FRAME RESTLISTTESTER DORESTLISTTEST 
-                                   GETRESTARGREFCNTS DORESTLISTTEST1)
-                              (INITVARS (RESTLISTCOUNTER 0))
-                              (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS RESTLISTCHECK \\COMPUTED.FORM)
-                                     (RECORDS MDSTYPEWORD)
-                                     (GLOBALVARS RESTLISTCOUNTER))
-                              (TESTS RESTLIST))
-                        (COMS                                (* \; "Closure tests")

-                              (FNS CLOSURETESTER CLOSUREMAINTEST CLOSUREMAINTEST.RECURSE 
-                                   CLOSUREFNCHECK CLOSUREFNCHECK2 CLOSUREFN1 CLOSUREFN1VALUE 
-                                   CLOSUREFN2 CLOSUREFN2VALUE CLOSUREFN4CODE CLOSUREFN4VALUE)
-                              (INITVARS (CLOSURETEST.DEPTH 50)
-                                     (CLOSURETEST.ENVIRONMENT "Closure Environment"))
-                              (GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT)
-                              (TESTS CLOSURES))
-                        (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
-                               (ADDVARS (NLAMA)
-                                      (NLAML)
-                                      (LAMA DORESTLISTTEST DOFINDKEYTEST)))))
-
-
-
-(* |;;| "This le contains tests for the various opcodes used in the system.")

-
-
-(RPAQ *TEST-FILE-NAME*
 "OPCODES")
-
-(ADDTOVAR DIRECTORIES
 {ERIS}<TEST>MAIKO>AUX>)
-
-(FILESLOAD OPTESTS BBTESTS)
-
-
-
-(* \; "BITBLT")

-
-
-(DEFTEST (BITBLT-DIAGONALS :COMPILED)
-   (FOR
 WIDTH
-      IN
 '(1 2 3 4 5 7 8 9 15 16 17 31 32 33 39 40 41) ALWAYS
 (PRINT WIDTH) 
-                                                             (* \; "DD")

-                                                                 (DIAGONALS WIDTH)))
-
-(DEFTEST (BITBLT-SLOPED-LINES :COMPILED)
-   (FOR
 I IN
 '(1 3 4 5 7 8 9 15 16 17) DO
 (SLOPED-LINES I))
-   T)
-
-
-
-(* \; "COPY.N")

-
-
-(DEFTEST (COPY.N :COMPILED)
-
-   (* |;;| "COPY.N  opcode")

-
-   (EQ :OK (XCL-USER::COPY.N.TEST)))
-
-(DEFTEST COPY.N-UFN
-   (EQ :OK (XCL-USER::COPY.N.TEST T)))
-
-
-
-(* \; "STORE.N")

-
-
-(DEFTEST (STORE.N :COMPILED)
-
-   (* |;;| "COPY.N  opcode")

-
-   (EQUAL '(5 4 T 2 1)
-          (XCL-USER::STORE.N.TEST)))
-
-(DEFTEST STORE.N-UFN
-
-   (* |;;| "STORE.N  opcode")

-
-   (EQUAL '(5 4 T 2 1)
-          (XCL-USER::STORE.N.TEST T)))
-
-
-
-(* \; "POP.N")

-
-
-(DEFTEST (POP.N :COMPILED)
-   (= 3 (XCL-USER::POP.N.TEST)))
-
-(DEFTEST POP.N-UFN
-   (= 3 (XCL-USER::POP.N.TEST T)))
-
-
-
-(* \; "UNWIND")

-
-
-(DEFTEST UNWIND-OFF-BY-1-A
-   (LET ((F CL:PI))
-        (EQUAL (LIST 'SUCCESS (PROGN (|for|
 C |in|
 (UNPACK F) |do|
 (PRIN1 C))
-                                     F))
-               '(SUCCESS 3.1415927))))
-
-(DEFTEST UNWIND-OFF-BY-1-B
-
-   (* |;;| "Make sure that UNWIND doesn't mung the binding for F during the for loop.")

-
-   (LET ((F CL:PI))
-        (|for|
 C |in|
 (UNPACK F) |do|
 (PRIN1 C))
-        (AND (FLOATP F)
-             (= F CL:PI))))
-(DEFINEQ
-
-(UNWINDTESTER

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 26-Sep-88 14:11 by bvm")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH)
-       |do|
 (LET ((VALUE (UNWINDMAINTEST
 D (LOGAND D 7))))
-                     (COND
-                        ((NEQ VALUE 'SUCCESS)
-                         (HELP "UNWINDMAINTEST did not return correctly" VALUE)))))
-    T))
-
-(UNWINDMAINTEST

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:10 by bvm")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET ((*B* 3)
-              (*C* 2)
-              (*D* DEPTH))
-             (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-             (LIST (UNWINDCHECK1
 DEPTH)
-                   (LET ((*E* 10)
-                         (*F* 11)
-                         (*G* 12)
-                         (*H* DEPTH))
-                        (DECLARE
 (CL:SPECIAL *E* *F* *G* *H*))
-
-                        (* |;;| "There are 8 pvar slots in this frame (for 7 pvars), so empty stack = 8+2 = 10.  Right now the stack depth is up to 13, because of two bind marks and the value returned from UNWINDCHECK1.")

-
-                        (UNWINDCHECKFAIL T *B* *C* *D* *E* *F* 'PREVPREV 'PREVIOUS-VALUE
-                               (PROGN                        (* \; 
-
                            "Unwind stack to depth 10 + {0,1,3,6} preserving tos when code is even")

-                                      (SELECTQ CODE
-                                          (0                 (* \; "Blow away whole stack")

-                                             ((OPCODES UNWIND 10 0)))
-                                          (1                 (* \; "Same as 0 but keep tos")

-                                             ((OPCODES UNWIND 10 1)))
-                                          (2                 (* \; "Blow away second binding only")

-                                             ((OPCODES UNWIND 11 0)))
-                                          (3                 (* \; "Same as 2 but keep tos")

-                                             ((OPCODES UNWIND 11 1)))
-                                          (4                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 13 0)))
-                                          (5                 (* \; "Same as 4 but keep tos")

-                                             ((OPCODES UNWIND 13 1)))
-                                          (6                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 16 0)))
-                                          ((OPCODES UNWIND 16 1))))
-                               (PROGN                        (* \; 
-
                                     "Check that previous opcode left the stack in the right state")

-                                      (UNWINDCHECK2
 CODE)))))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UNWINDMAINTEST.RECURSE
 (SUB1 DEPTH)
-                 CODE)))))
-
-(UNWINDMAINTEST.RECURSE

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:08 by bvm")

-    (UNWINDMAINTEST
 DEPTH CODE)))
-
-(UNWINDCHECK1

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 13:15")

-                                                             (* \; 
-
                                                "This just prevents compiler from merging specials")

-    NIL))
-
-(UNWINDCHECK2

-  (LAMBDA (CODE)
                                         (* \; "Edited 26-Sep-88 14:10 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.  TOS should be PREVIOUS-VALUE if the UNWIND said to preserve TOS.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD (+ 10 (LOGAND CODE 1)
-                                  (SELECTQ (LRSH CODE 1)
-                                      (0 0)
-                                      (1 1)
-                                      (2 3)
-                                      6))
-                              WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT (UNWINDCODE
 CODE)
-                           " unwound stack "
-                           (COND
-                              ((GREATERP GOODEOS EOS)
-                               "too far")
-                              (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words")))
-             ((AND (ODDP CODE)
-                   (NEQ (\\GETBASEPTR (ADDSTACKBASE (IDIFFERENCE EOS WORDSPERCELL))
-                               0)
-                        'PREVIOUS-VALUE))                    (* \; "Should have preserved tos")

-              (HELP (UNWINDCODE
 CODE)
-                    " did not preserve top of stack")))
-          (|for|
 V |in|
 '(*B* *C* *D* *E* *F* *G* *H*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (SELECTQ (LRSH CODE 1)
-                                                 (0 T)
-                                                 (1 (FMEMB V '(*E* *F* *G* *H*)))
-                                                 NIL))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT (UNWINDCODE
 CODE)
-                                                         " left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT (UNWINDCODE
 CODE)
-                                    " left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from UNWINDMAINTEST because the UNWIND there has ruined its stack")

-
-                 (RETFROM 'UNWINDMAINTEST 'SUCCESS)))))
-
-(UNWINDCODE

-  (LAMBDA (CODE)
                                         (* |bvm:| "21-Jul-86 15:34")

-    (CONCAT "UNWIND." (PLUS 10 (LOGAND CODE 1))
-           "."
-           (LRSH CODE 1))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD BINDMARKSLOT
 ((BINDMARKP FLAG)
-                               (NIL BITS 15))
-                              (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD)
-                                                         (BINDLASTPVAR WORD)))
-                              (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN 
-                                                             (* |Value| |stored| |in| |high| 
-
                                                           |half| |is| |one's| |complement| 
-
                                                           |of| |number| |of| |values| |bound|)

-                                                                           (LOGXOR (|fetch|

-                                                                                    BINDNEGVALUES
-                                                                                      |of|
 DATUM)
-                                                                                  65535))))))
-)
-)
-(DEFINEQ
-
-(UW2.TEST

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 15:00 by vanmelle")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (UW2.TEST.MAIN
))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UW2.RECURSE
 (SUB1 DEPTH))))))
-
-(UW2.RECURSE

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 14:56 by vanmelle")

-                                                             (* \; "To foil compiler")

-    (UW2.TEST
 DEPTH)))
-
-(UW2.TEST.MAIN

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 20-Oct-88 15:49 by bvm")

-    (LET ((*B* 3)
-          (*C* 2.4)
-          (*D* DEPTH))
-         (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-         (LIST (UW2.IDENTITY
 'TOS)
-               (LET ((*E* 3.5))
-                    (DECLARE
 (CL:SPECIAL *E*))
-
-                    (* |;;| "There are 4 pvar slots in this frame, so empty stack = 4+2 = 6.  Right now the stack depth is up to 9, because of 2 bind marks and the value from NILL.")

-
-                    (UNWINDCHECKFAIL T NIL ((OPCODES UNWIND 9 0))
-                           (UW2.CHECK
)))))))
-
-(UW2.CHECK

-  (LAMBDA NIL
                                            (* \; "Edited 20-Oct-88 15:49 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD 9 WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT "Unwound stack " (COND
-                                                ((GREATERP GOODEOS EOS)
-                                                 "too far")
-                                                (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words"))))
-          (|for|
 V |in|
 '(*B* *C* *D* *E*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (AND NIL (EQ V '*E*)))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT "UNWIND left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT "UNWIND left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from test because the UNWIND there has confused its stack")

-
-                 (RETFROM 'UW2.TEST.MAIN 'SUCCESS)))))
-
-(UW2.IDENTITY

-  (LAMBDA (X)
                                            (* \; "Edited 20-Oct-88 15:19 by bvm")

-                                                             (* \; 
-
                                                           "Identity compiler doesn't know about")

-    X))
-)
-
-(DEFTEST (UNWIND :COMPILED)
-   (UNWINDTESTER
))
-
-(DEFTEST (UNWIND-2 :COMPILED)
-   (FOR
 I FROM
 0 TO
 100 ALWAYS
 (EQ 'SUCCESS (UW2.TEST
 I))))
-
-
-
-(* \; "FINDKEY")

-
-(DEFINEQ
-
-(FINDKEYTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "14-Jul-86 17:54")

-
-(* |;;;| "Test the opcode FINDKEY")

-
-    (DOFINDKEYTEST
 'KEYA 'VALA 'KEYB 'VALB 'KEYC 'VALC)))
-
-(DOFINDKEYTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (FINDKEYCHECK 1 KEYA)
-         (FINDKEYCHECK 2 KEYA)
-         (FINDKEYCHECK 3 KEYA)
-         (FINDKEYCHECK 4 KEYA)
-         (FINDKEYCHECK 5 KEYA)
-         (FINDKEYCHECK 6 KEYA)
-         (FINDKEYCHECK 7 KEYA)
-         (FINDKEYCHECK 8 KEYA)
-         (FINDKEYCHECK 1 KEYB)
-         (FINDKEYCHECK 2 KEYB)
-         (FINDKEYCHECK 3 KEYB)
-         (FINDKEYCHECK 4 KEYB)
-         (FINDKEYCHECK 5 KEYB)
-         (FINDKEYCHECK 6 KEYB)
-         (FINDKEYCHECK 7 KEYB)
-         (FINDKEYCHECK 8 KEYB)
-         (FINDKEYCHECK 1 KEYC)
-         (FINDKEYCHECK 2 KEYC)
-         (FINDKEYCHECK 3 KEYC)
-         (FINDKEYCHECK 4 KEYC)
-         (FINDKEYCHECK 5 KEYC)
-         (FINDKEYCHECK 6 KEYC)
-         (FINDKEYCHECK 7 KEYC)
-         (FINDKEYCHECK 8 KEYC))))
-
-(DOFINDKEYTEST1

-  (LAMBDA (RESULT N KEY)
                                 (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (LET ((ANSWER (|for|
 I |from|
 N |by|
 2 |to|
 KEYARGS
-                     |when|
 (EQ KEY (ARG KEYARGS I)) |do|
 (RETURN (ADD1 I)))))
-         (COND
-            ((NEQ ANSWER RESULT)
-             (HELP (CONCAT "FINDKEY." N " returned " RESULT " instead of " ANSWER " for ")
-                   KEY))
-            (T T)))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS FINDKEYCHECK DMACRO (DEFMACRO (N KEY) `(DOFINDKEYTEST1
 ((OPCODES FINDKEY ,N)
-                                                                      ',KEY)
-                                                        ,N
-                                                        ',KEY)))
-)
-)
-
-(DEFTEST (FINDKEY :COMPILED)
-   (FINDKEYTESTER
))
-
-
-
-(* \; "RESTLIST")

-
-(DEFINEQ
-
-(\\RESTLIST.SPLICE.FRAME

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:13")

-
-(* |;;;| "If caller is fast, so its BF is contiguous with its caller's FX, then adjust pointers so that its first ivar goes back on it's caller's fx, and back up pc")

-
-    (UNINTERRUPTABLY
-        (LET ((CALLER (\\MYALINK))
-              CALLER2 IVAR BF)
-             (COND
-                ((AND (|fetch|
 (FX FASTP) |of|
 CALLER)
-                      (EQ (SETQ IVAR (|fetch|
 (BF IVAR) |of|
 (SETQ BF (|fetch|

-                                                                               (FX DUMMYBF)
-                                                                                 |of|
 CALLER))))
-                          (|fetch|
 (FX NEXTBLOCK) |of|
 (SETQ CALLER2 (|fetch|

-                                                                              (FX ALINK) |of|

-                                                                                         CALLER)))))
-                 (|replace|
 (BF IVAR) |of|
 BF |with|
 (|add|
 IVAR WORDSPERCELL))
-                 (|replace|
 (FX NEXTBLOCK) |of|
 CALLER2 |with|
 IVAR)
-                 (|add|
 (|fetch|
 (FX PC) |of|
 CALLER2)
-                        -2)
-                 T))))))
-
-(RESTLISTTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:28")

-
-(* |;;;| "Test the opcode RESTLIST")

-
-    (AND (DORESTLISTTEST
 'KEYA 'VALA 'KEYB 'VALB 'KEYC 'VALC)
-         (DORESTLISTTEST
 '(KEYA)
-                '(VALA)
-                '(KEYB)
-                'VALB
-                '(KEYC)
-                '(VALC))
-         (DORESTLISTTEST
)
-         (\\COMPUTED.FORM (CONS 'DORESTLISTTEST (|for|
 I |from|
 1 |to|
 200
-                                                   |collect|
 `',(LIST I)))))))
-
-(DORESTLISTTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:39")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (RESTLISTCHECK 1)
-         (RESTLISTCHECK 2)
-         (RESTLISTCHECK 3)
-         (RESTLISTCHECK 4)
-         (RESTLISTCHECK 5)
-         (RESTLISTCHECK 6)
-         (RESTLISTCHECK 7)
-         (RESTLISTCHECK 8))))
-
-(GETRESTARGREFCNTS

-  (LAMBDA (N)
-    (DECLARE
 (USEDFREE KEYARGS))
                     (* |bvm:| "18-Jul-86 15:01")

-    (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (\\REFCNT (ARG KEYARGS I)))))
-
-(DORESTLISTTEST1

-  (LAMBDA (REFCNTS RESULT N)
                             (* |bvm:| "21-Jul-86 17:22")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (COND
-       ((OR (NOT (EQLENGTH RESULT (IMAX (IDIFFERENCE KEYARGS (SUB1 N))
-                                        0)))
-            (|for|
 R |in|
 RESULT |as|
 I |from|
 N |to|
 KEYARGS
-               |thereis|
 (NEQ R (ARG KEYARGS I))))
-        (HELP (CONCAT "RESTLIST." N " returned " RESULT " instead of "
-                     (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (ARG KEYARGS I))))))
-    (|for|
 TAIL |on|
 RESULT |as|
 CNT |in|
 REFCNTS |as|
 I |from|
 1
-       |do|
 (COND
-                   ((AND (NEQ (\\REFCNT (CAR TAIL))
-                              (ADD1 CNT))
-                         (NOT (|fetch|
 (MDSTYPEWORD NOREFCNT)
-                                 |of|
 (\\ADDBASE |\\MDSTypeTable| (LRSH (|fetch|
 (POINTER
-                                                                                          PAGE#)
-                                                                               |of|
 (CAR TAIL))
-                                                                            1)))))
-                    (HELP (CONCAT "Ref cnt of " I "th RESTLIST element was not incremented")
-                          (CONCAT "Was " CNT ", now is " (\\REFCNT (CAR TAIL)))))
-                   ((NEQ (\\REFCNT TAIL)
-                         (COND
-                            ((EQ TAIL RESULT)
-                             0)
-                            (T 1)))
-                    (HELP (COND
-                             ((EQ TAIL RESULT)
-                              "Ref cnt of RESTLIST value is not zero")
-                             (T "Ref cnt of RESTLIST tail is not one"))
-                          (\\REFCNT TAIL)))))
-    T))
-)
-
-(RPAQ? RESTLISTCOUNTER
 0)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS RESTLISTCHECK DMACRO (DEFMACRO (N) `(PROGN (RECLAIM)
-                                                     (DORESTLISTTEST1
 (GETRESTARGREFCNTS

-                                                                           ,N)
-                                                            ((OPCODES RESTLIST ,N)
-                                                             NIL KEYARGS)
-                                                            ,N))))
-
-(PUTPROPS \\COMPUTED.FORM MACRO (X (CONS 'PROGN (MAPCAR X (FUNCTION EVAL)))))
-)
-
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD MDSTYPEWORD
 ((NOREFCNT FLAG)
-                              (NIL BITS 15)))
-)
-
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS RESTLISTCOUNTER)
-)
-)
-
-(DEFTEST (RESTLIST :COMPILED)
-   (RESTLISTTESTER
))
-
-
-
-(* \; "Closure tests")

-
-(DEFINEQ
-
-(CLOSURETESTER

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH) |always|
 (CLOSUREMAINTEST

-                                                                                  D))))
-
-(CLOSUREMAINTEST

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET (VALUE)
-             (PUTD 'CLOSUREFN4 (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM DEFPOINTER)
-                                                         |of|
 'CLOSUREFN4CODE)
-                                      CLOSURETEST.ENVIRONMENT))
-             (COND
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (GETD 'CLOSUREFN1)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN1VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN1 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM 
-                                                                                           DEFPOINTER
-                                                                                             )
-                                                                            |of|
 'CLOSUREFN2)
-                                                         CLOSURETEST.ENVIRONMENT)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN2VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN2 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (CLOSUREFN4))
-                             (CLOSUREFN4VALUE
)))
-                 (HELP "CLOSUREFN4 returned the wrong value" VALUE))
-                (T T))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (CLOSUREMAINTEST.RECURSE
 (SUB1 DEPTH))))))
-
-(CLOSUREMAINTEST.RECURSE

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "18-Jul-86 14:07")

-    (CLOSUREMAINTEST
 DEPTH)))
-
-(CLOSUREFNCHECK

-  (LAMBDA (CLOSUREP FUNCALLP)
                            (* |bvm:| "18-Jul-86 14:48")

-    (LET* ((CALLER (\\MYALINK))
-           (PVAR0 (STACKADDBASE (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER))))
-          (COND
-             (CLOSUREP (COND
-                          ((NEQ (\\GETBASEPTR PVAR0 0)
-                                CLOSURETEST.ENVIRONMENT)
-                           (HELP (COND
-                                    (FUNCALLP "FUNCALL of a full closure")
-                                    (T "Call to symbol with Closure definition"))
-                                 " did not store closure environment in pvar0"))))
-             ((|fetch|
 (PVARSLOT BOUND) |of|
 PVAR0)
-              (HELP "FUNCALL of a null closure stored something into pvar0"))))))
-
-(CLOSUREFNCHECK2

-  (LAMBDA NIL
                                            (* |bvm:| "18-Jul-86 14:51")

-                                                             (* \; 
-
                                                           "Nothing really to check for now")

-    NIL))
-
-(CLOSUREFN1

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN1VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN1VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-    (LIST ARG1 ARG2 ARG3 ARG4)))
-
-(CLOSUREFN2

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 T T)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN2VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN2VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-    (LIST ARG4 ARG3 ARG2 ARG1)))
-
-(CLOSUREFN4CODE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:53")

-                                                             (* \; "closure called via FNx")

-    (CLOSUREFNCHECK
 T NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN4VALUE
 ARG1 ARG2 ARG3))))
-
-(CLOSUREFN4VALUE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:38")

-    (LIST ARG2 ARG3 ARG1)))
-)
-
-(RPAQ? CLOSURETEST.DEPTH
 50)
-
-(RPAQ? CLOSURETEST.ENVIRONMENT
 "Closure Environment")
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT)
-)
-
-(DEFTEST (CLOSURES :COMPILED)
-   (CLOSURETESTER
))
-(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
-
-(ADDTOVAR NLAMA
 )
-
-(ADDTOVAR NLAML
 )
-
-(ADDTOVAR LAMA
 DORESTLISTTEST DOFINDKEYTEST)
-)
-(PUTPROPS OPCODES.TEST COPYRIGHT ("ENVOS Corporation" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (5527 12310 (UNWINDTESTER 5537 . 5958) (UNWINDMAINTEST 5960 . 8968) (
-UNWINDMAINTEST.RECURSE 8970 . 9139) (UNWINDCHECK1 9141 . 9439) (UNWINDCHECK2 9441 . 12106) (UNWINDCODE
- 12108 . 12308)) (13386 16645 (UW2.TEST 13396 . 13827) (UW2.RECURSE 13829 . 14068) (UW2.TEST.MAIN 
-14070 . 14727) (UW2.CHECK 14729 . 16337) (UW2.IDENTITY 16339 . 16643)) (16834 18457 (FINDKEYTESTER 
-16844 . 17060) (DOFINDKEYTEST 17062 . 17958) (DOFINDKEYTEST1 17960 . 18455)) (18894 23287 (
-\\RESTLIST.SPLICE.FRAME 18904 . 20238) (RESTLISTTESTER 20240 . 20818) (DORESTLISTTEST 20820 . 21189) (
-GETRESTARGREFCNTS 21191 . 21412) (DORESTLISTTEST1 21414 . 23285)) (24200 29616 (CLOSURETESTER 24210 . 
-24512) (CLOSUREMAINTEST 24514 . 26515) (CLOSUREMAINTEST.RECURSE 26517 . 26673) (CLOSUREFNCHECK 26675
- . 27478) (CLOSUREFNCHECK2 27480 . 27774) (CLOSUREFN1 27776 . 28265) (CLOSUREFN1VALUE 28267 . 28414) (
-CLOSUREFN2 28416 . 28905) (CLOSUREFN2VALUE 28907 . 29054) (CLOSUREFN4CODE 29056 . 29470) (
-CLOSUREFN4VALUE 29472 . 29614)))))
-STOP

internal/test/Maiko/AUTO/OPCODES.TEST.~2~

@@ -1,712 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "27-Oct-88 10:25:24" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;5
 30734  
-
-      |changes| |to:|  (FNS FINDKEYTESTER DOFINDKEYTEST DOFINDKEYTEST1 \\RESTLIST.SPLICE.FRAME 
-                            RESTLISTTESTER DORESTLISTTEST GETRESTARGREFCNTS DORESTLISTTEST1 
-                            UNWINDTESTER UNWINDMAINTEST UNWINDMAINTEST.RECURSE UNWINDCHECK1 
-                            UNWINDCHECK2 UNWINDCODE UW2.TEST UW2.RECURSE UW2.TEST.MAIN UW2.CHECK 
-                            UW2.IDENTITY CLOSURETESTER CLOSUREMAINTEST CLOSUREMAINTEST.RECURSE 
-                            CLOSUREFNCHECK CLOSUREFNCHECK2 CLOSUREFN1 CLOSUREFN1VALUE CLOSUREFN2 
-                            CLOSUREFN2VALUE CLOSUREFN4CODE CLOSUREFN4VALUE)
-                       (VARS OPCODESCOMS)
-                       (TESTS BITBLT-DIAGONALS BITBLT-SLOPED-LINES COPY.N STORE.N POP.N UNWIND 
-                              UNWIND-2 FINDKEY RESTLIST CLOSURES)
-
-      |previous| |date:| "26-Oct-88 19:11:04" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;4)
-
-
-; Copyright (c) 1988 by ENVOS Corporation.  All rights reserved.
-
-(PRETTYCOMPRINT OPCODESCOMS)
-
-(RPAQQ OPCODESCOMS
 (
-                        (* |;;| 
-
                      "This file contains tests for the various opcodes used in the system.")

-
-                        (VARS (*TEST-FILE-NAME* "OPCODES"))
-                        (ADDVARS (DIRECTORIES {ERIS}<TEST>MAIKO>AUX>))
-                        (FILES OPTESTS BBTESTS)
-                        (COMS                                (* \; "BITBLT")

-                              (TESTS BITBLT-DIAGONALS BITBLT-SLOPED-LINES))
-                        (COMS                                (* \; "COPY.N")

-                              (TESTS COPY.N COPY.N-UFN))
-                        (COMS                                (* \; "STORE.N")

-                              (TESTS STORE.N STORE.N-UFN))
-                        (COMS                                (* \; "POP.N")

-                              (TESTS POP.N POP.N-UFN))
-                        (COMS                                (* \; "UNWIND")

-                              (TESTS UNWIND-OFF-BY-1-A UNWIND-OFF-BY-1-B)
-                              (FNS UNWINDTESTER UNWINDMAINTEST UNWINDMAINTEST.RECURSE UNWINDCHECK1 
-                                   UNWINDCHECK2 UNWINDCODE)
-                              (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS BINDMARKSLOT))
-                              (FNS UW2.TEST UW2.RECURSE UW2.TEST.MAIN UW2.CHECK UW2.IDENTITY)
-                              (TESTS UNWIND UNWIND-2))
-                        (COMS                                (* \; "FINDKEY")

-                              (FNS FINDKEYTESTER DOFINDKEYTEST DOFINDKEYTEST1)
-                              (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS FINDKEYCHECK))
-                              (TESTS FINDKEY))
-                        (COMS                                (* \; "RESTLIST")

-                              (FNS \\RESTLIST.SPLICE.FRAME RESTLISTTESTER DORESTLISTTEST 
-                                   GETRESTARGREFCNTS DORESTLISTTEST1)
-                              (INITVARS (RESTLISTCOUNTER 0))
-                              (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS RESTLISTCHECK \\COMPUTED.FORM)
-                                     (RECORDS MDSTYPEWORD)
-                                     (GLOBALVARS RESTLISTCOUNTER))
-                              (TESTS RESTLIST))
-                        (COMS                                (* \; "Closure tests")

-                              (FNS CLOSURETESTER CLOSUREMAINTEST CLOSUREMAINTEST.RECURSE 
-                                   CLOSUREFNCHECK CLOSUREFNCHECK2 CLOSUREFN1 CLOSUREFN1VALUE 
-                                   CLOSUREFN2 CLOSUREFN2VALUE CLOSUREFN4CODE CLOSUREFN4VALUE)
-                              (INITVARS (CLOSURETEST.DEPTH 50)
-                                     (CLOSURETEST.ENVIRONMENT "Closure Environment"))
-                              (GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT)
-                              (TESTS CLOSURES))
-                        (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
-                               (ADDVARS (NLAMA)
-                                      (NLAML)
-                                      (LAMA DORESTLISTTEST DOFINDKEYTEST)))))
-
-
-
-(* |;;| "This file contains tests for the various opcodes used in the system.")

-
-
-(RPAQ *TEST-FILE-NAME*
 "OPCODES")
-
-(ADDTOVAR DIRECTORIES
 {ERIS}<TEST>MAIKO>AUX>)
-
-(FILESLOAD OPTESTS BBTESTS)
-
-
-
-(* \; "BITBLT")

-
-
-(DEFTEST (BITBLT-DIAGONALS :COMPILED)
-   (FOR
 WIDTH
-      IN
 '(1 2 3 4 5 7 8 9 15 16 17 31 32 33 39 40 41) ALWAYS
 (PRINT WIDTH) 
-                                                             (* \; "DD")

-                                                                 (DIAGONALS WIDTH)))
-
-(DEFTEST (BITBLT-SLOPED-LINES :COMPILED)
-   (FOR
 I IN
 '(1 3 4 5 7 8 9 15 16 17) DO
 (SLOPED-LINES I))
-   T)
-
-
-
-(* \; "COPY.N")

-
-
-(DEFTEST (COPY.N :COMPILED)
-
-   (* |;;| "COPY.N  opcode")

-
-   (EQ :OK (XCL-USER::COPY.N.TEST)))
-
-(DEFTEST COPY.N-UFN
-   (EQ :OK (XCL-USER::COPY.N.TEST T)))
-
-
-
-(* \; "STORE.N")

-
-
-(DEFTEST (STORE.N :COMPILED)
-
-   (* |;;| "COPY.N  opcode")

-
-   (EQUAL '(5 4 T 2 1)
-          (XCL-USER::STORE.N.TEST)))
-
-(DEFTEST STORE.N-UFN
-
-   (* |;;| "STORE.N  opcode")

-
-   (EQUAL '(5 4 T 2 1)
-          (XCL-USER::STORE.N.TEST T)))
-
-
-
-(* \; "POP.N")

-
-
-(DEFTEST (POP.N :COMPILED)
-   (= 3 (XCL-USER::POP.N.TEST)))
-
-(DEFTEST POP.N-UFN
-   (= 3 (XCL-USER::POP.N.TEST T)))
-
-
-
-(* \; "UNWIND")

-
-
-(DEFTEST UNWIND-OFF-BY-1-A
-   (LET ((F CL:PI))
-        (EQUAL (LIST 'SUCCESS (PROGN (|for|
 C |in|
 (UNPACK F) |do|
 (PRIN1 C))
-                                     F))
-               '(SUCCESS 3.1415927))))
-
-(DEFTEST UNWIND-OFF-BY-1-B
-
-   (* |;;| "Make sure that UNWIND doesn't mung the binding for F during the for loop.")

-
-   (LET ((F CL:PI))
-        (|for|
 C |in|
 (UNPACK F) |do|
 (PRIN1 C))
-        (AND (FLOATP F)
-             (= F CL:PI))))
-(DEFINEQ
-
-(UNWINDTESTER

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 26-Sep-88 14:11 by bvm")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH)
-       |do|
 (LET ((VALUE (UNWINDMAINTEST
 D (LOGAND D 7))))
-                     (COND
-                        ((NEQ VALUE 'SUCCESS)
-                         (HELP "UNWINDMAINTEST did not return correctly" VALUE)))))
-    T))
-
-(UNWINDMAINTEST

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:10 by bvm")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET ((*B* 3)
-              (*C* 2)
-              (*D* DEPTH))
-             (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-             (LIST (UNWINDCHECK1
 DEPTH)
-                   (LET ((*E* 10)
-                         (*F* 11)
-                         (*G* 12)
-                         (*H* DEPTH))
-                        (DECLARE
 (CL:SPECIAL *E* *F* *G* *H*))
-
-                        (* |;;| "There are 8 pvar slots in this frame (for 7 pvars), so empty stack = 8+2 = 10.  Right now the stack depth is up to 13, because of two bind marks and the value returned from UNWINDCHECK1.")

-
-                        (UNWINDCHECKFAIL T *B* *C* *D* *E* *F* 'PREVPREV 'PREVIOUS-VALUE
-                               (PROGN                        (* \; 
-
                            "Unwind stack to depth 10 + {0,1,3,6} preserving tos when code is even")

-                                      (SELECTQ CODE
-                                          (0                 (* \; "Blow away whole stack")

-                                             ((OPCODES UNWIND 10 0)))
-                                          (1                 (* \; "Same as 0 but keep tos")

-                                             ((OPCODES UNWIND 10 1)))
-                                          (2                 (* \; "Blow away second binding only")

-                                             ((OPCODES UNWIND 11 0)))
-                                          (3                 (* \; "Same as 2 but keep tos")

-                                             ((OPCODES UNWIND 11 1)))
-                                          (4                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 13 0)))
-                                          (5                 (* \; "Same as 4 but keep tos")

-                                             ((OPCODES UNWIND 13 1)))
-                                          (6                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 16 0)))
-                                          ((OPCODES UNWIND 16 1))))
-                               (PROGN                        (* \; 
-
                                     "Check that previous opcode left the stack in the right state")

-                                      (UNWINDCHECK2
 CODE)))))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UNWINDMAINTEST.RECURSE
 (SUB1 DEPTH)
-                 CODE)))))
-
-(UNWINDMAINTEST.RECURSE

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:08 by bvm")

-    (UNWINDMAINTEST
 DEPTH CODE)))
-
-(UNWINDCHECK1

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 13:15")

-                                                             (* \; 
-
                                                "This just prevents compiler from merging specials")

-    NIL))
-
-(UNWINDCHECK2

-  (LAMBDA (CODE)
                                         (* \; "Edited 26-Sep-88 14:10 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.  TOS should be PREVIOUS-VALUE if the UNWIND said to preserve TOS.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD (+ 10 (LOGAND CODE 1)
-                                  (SELECTQ (LRSH CODE 1)
-                                      (0 0)
-                                      (1 1)
-                                      (2 3)
-                                      6))
-                              WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT (UNWINDCODE
 CODE)
-                           " unwound stack "
-                           (COND
-                              ((GREATERP GOODEOS EOS)
-                               "too far")
-                              (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words")))
-             ((AND (ODDP CODE)
-                   (NEQ (\\GETBASEPTR (ADDSTACKBASE (IDIFFERENCE EOS WORDSPERCELL))
-                               0)
-                        'PREVIOUS-VALUE))                    (* \; "Should have preserved tos")

-              (HELP (UNWINDCODE
 CODE)
-                    " did not preserve top of stack")))
-          (|for|
 V |in|
 '(*B* *C* *D* *E* *F* *G* *H*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (SELECTQ (LRSH CODE 1)
-                                                 (0 T)
-                                                 (1 (FMEMB V '(*E* *F* *G* *H*)))
-                                                 NIL))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT (UNWINDCODE
 CODE)
-                                                         " left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT (UNWINDCODE
 CODE)
-                                    " left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from UNWINDMAINTEST because the UNWIND there has ruined its stack")

-
-                 (RETFROM 'UNWINDMAINTEST 'SUCCESS)))))
-
-(UNWINDCODE

-  (LAMBDA (CODE)
                                         (* |bvm:| "21-Jul-86 15:34")

-    (CONCAT "UNWIND." (PLUS 10 (LOGAND CODE 1))
-           "."
-           (LRSH CODE 1))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD BINDMARKSLOT
 ((BINDMARKP FLAG)
-                               (NIL BITS 15))
-                              (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD)
-                                                         (BINDLASTPVAR WORD)))
-                              (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN 
-                                                             (* |Value| |stored| |in| |high| 
-
                                                           |half| |is| |one's| |complement| 
-
                                                           |of| |number| |of| |values| |bound|)

-                                                                           (LOGXOR (|fetch|

-                                                                                    BINDNEGVALUES
-                                                                                      |of|
 DATUM)
-                                                                                  65535))))))
-)
-)
-(DEFINEQ
-
-(UW2.TEST

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 15:00 by vanmelle")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (UW2.TEST.MAIN
))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UW2.RECURSE
 (SUB1 DEPTH))))))
-
-(UW2.RECURSE

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 14:56 by vanmelle")

-                                                             (* \; "To foil compiler")

-    (UW2.TEST
 DEPTH)))
-
-(UW2.TEST.MAIN

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 20-Oct-88 15:49 by bvm")

-    (LET ((*B* 3)
-          (*C* 2.4)
-          (*D* DEPTH))
-         (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-         (LIST (UW2.IDENTITY
 'TOS)
-               (LET ((*E* 3.5))
-                    (DECLARE
 (CL:SPECIAL *E*))
-
-                    (* |;;| "There are 4 pvar slots in this frame, so empty stack = 4+2 = 6.  Right now the stack depth is up to 9, because of 2 bind marks and the value from NILL.")

-
-                    (UNWINDCHECKFAIL T NIL ((OPCODES UNWIND 9 0))
-                           (UW2.CHECK
)))))))
-
-(UW2.CHECK

-  (LAMBDA NIL
                                            (* \; "Edited 20-Oct-88 15:49 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD 9 WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT "Unwound stack " (COND
-                                                ((GREATERP GOODEOS EOS)
-                                                 "too far")
-                                                (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words"))))
-          (|for|
 V |in|
 '(*B* *C* *D* *E*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (AND NIL (EQ V '*E*)))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT "UNWIND left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT "UNWIND left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from test because the UNWIND there has confused its stack")

-
-                 (RETFROM 'UW2.TEST.MAIN 'SUCCESS)))))
-
-(UW2.IDENTITY

-  (LAMBDA (X)
                                            (* \; "Edited 20-Oct-88 15:19 by bvm")

-                                                             (* \; 
-
                                                           "Identity compiler doesn't know about")

-    X))
-)
-
-(DEFTEST (UNWIND :COMPILED)
-   (UNWINDTESTER
))
-
-(DEFTEST (UNWIND-2 :COMPILED)
-   (FOR
 I FROM
 0 TO
 100 ALWAYS
 (EQ 'SUCCESS (UW2.TEST
 I))))
-
-
-
-(* \; "FINDKEY")

-
-(DEFINEQ
-
-(FINDKEYTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "14-Jul-86 17:54")

-
-(* |;;;| "Test the opcode FINDKEY")

-
-    (DOFINDKEYTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)))
-
-(DOFINDKEYTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (FINDKEYCHECK 1 ||)
-         (FINDKEYCHECK 2 ||)
-         (FINDKEYCHECK 3 ||)
-         (FINDKEYCHECK 4 ||)
-         (FINDKEYCHECK 5 ||)
-         (FINDKEYCHECK 6 ||)
-         (FINDKEYCHECK 7 ||)
-         (FINDKEYCHECK 8 ||)
-         (FINDKEYCHECK 1 KEYB)
-         (FINDKEYCHECK 2 KEYB)
-         (FINDKEYCHECK 3 KEYB)
-         (FINDKEYCHECK 4 KEYB)
-         (FINDKEYCHECK 5 KEYB)
-         (FINDKEYCHECK 6 KEYB)
-         (FINDKEYCHECK 7 KEYB)
-         (FINDKEYCHECK 8 KEYB)
-         (FINDKEYCHECK 1 KEYC)
-         (FINDKEYCHECK 2 KEYC)
-         (FINDKEYCHECK 3 KEYC)
-         (FINDKEYCHECK 4 KEYC)
-         (FINDKEYCHECK 5 KEYC)
-         (FINDKEYCHECK 6 KEYC)
-         (FINDKEYCHECK 7 KEYC)
-         (FINDKEYCHECK 8 KEYC))))
-
-(DOFINDKEYTEST1

-  (LAMBDA (RESULT N KEY)
                                 (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (LET ((ANSWER (|for|
 I |from|
 N |by|
 2 |to|
 KEYARGS
-                     |when|
 (EQ KEY (ARG KEYARGS I)) |do|
 (RETURN (ADD1 I)))))
-         (COND
-            ((NEQ ANSWER RESULT)
-             (HELP (CONCAT "FINDKEY." N " returned " RESULT " instead of " ANSWER " for ")
-                   KEY))
-            (T T)))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS FINDKEYCHECK DMACRO (DEFMACRO (N KEY) `(DOFINDKEYTEST1
 ((OPCODES FINDKEY ,N)
-                                                                      ',KEY)
-                                                        ,N
-                                                        ',KEY)))
-)
-)
-
-(DEFTEST (FINDKEY :COMPILED)
-   (FINDKEYTESTER
))
-
-
-
-(* \; "RESTLIST")

-
-(DEFINEQ
-
-(\\RESTLIST.SPLICE.FRAME

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:13")

-
-(* |;;;| "If caller is fast, so its BF is contiguous with its caller's FX, then adjust pointers so that its first ivar goes back on it's caller's fx, and back up pc")

-
-    (UNINTERRUPTABLY
-        (LET ((CALLER (\\MYALINK))
-              CALLER2 IVAR BF)
-             (COND
-                ((AND (|fetch|
 (FX FASTP) |of|
 CALLER)
-                      (EQ (SETQ IVAR (|fetch|
 (BF IVAR) |of|
 (SETQ BF (|fetch|

-                                                                               (FX DUMMYBF)
-                                                                                 |of|
 CALLER))))
-                          (|fetch|
 (FX NEXTBLOCK) |of|
 (SETQ CALLER2 (|fetch|

-                                                                              (FX ALINK) |of|

-                                                                                         CALLER)))))
-                 (|replace|
 (BF IVAR) |of|
 BF |with|
 (|add|
 IVAR WORDSPERCELL))
-                 (|replace|
 (FX NEXTBLOCK) |of|
 CALLER2 |with|
 IVAR)
-                 (|add|
 (|fetch|
 (FX PC) |of|
 CALLER2)
-                        -2)
-                 T))))))
-
-(RESTLISTTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:28")

-
-(* |;;;| "Test the opcode RESTLIST")

-
-    (AND (DORESTLISTTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)
-         (DORESTLISTTEST
 '(||)
-                '(VALA)
-                '(KEYB)
-                'VALB
-                '(KEYC)
-                '(VALC))
-         (DORESTLISTTEST
)
-         (\\COMPUTED.FORM (CONS 'DORESTLISTTEST (|for|
 I |from|
 1 |to|
 200
-                                                   |collect|
 `',(LIST I)))))))
-
-(DORESTLISTTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:39")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (RESTLISTCHECK 1)
-         (RESTLISTCHECK 2)
-         (RESTLISTCHECK 3)
-         (RESTLISTCHECK 4)
-         (RESTLISTCHECK 5)
-         (RESTLISTCHECK 6)
-         (RESTLISTCHECK 7)
-         (RESTLISTCHECK 8))))
-
-(GETRESTARGREFCNTS

-  (LAMBDA (N)
-    (DECLARE
 (USEDFREE KEYARGS))
                     (* |bvm:| "18-Jul-86 15:01")

-    (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (\\REFCNT (ARG KEYARGS I)))))
-
-(DORESTLISTTEST1

-  (LAMBDA (REFCNTS RESULT N)
                             (* |bvm:| "21-Jul-86 17:22")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (COND
-       ((OR (NOT (EQLENGTH RESULT (IMAX (IDIFFERENCE KEYARGS (SUB1 N))
-                                        0)))
-            (|for|
 R |in|
 RESULT |as|
 I |from|
 N |to|
 KEYARGS
-               |thereis|
 (NEQ R (ARG KEYARGS I))))
-        (HELP (CONCAT "RESTLIST." N " returned " RESULT " instead of "
-                     (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (ARG KEYARGS I))))))
-    (|for|
 TAIL |on|
 RESULT |as|
 CNT |in|
 REFCNTS |as|
 I |from|
 1
-       |do|
 (COND
-                   ((AND (NEQ (\\REFCNT (CAR TAIL))
-                              (ADD1 CNT))
-                         (NOT (|fetch|
 (MDSTYPEWORD NOREFCNT)
-                                 |of|
 (\\ADDBASE |\\MDSTypeTable| (LRSH (|fetch|
 (POINTER
-                                                                                          PAGE#)
-                                                                               |of|
 (CAR TAIL))
-                                                                            1)))))
-                    (HELP (CONCAT "Ref cnt of " I "th RESTLIST element was not incremented")
-                          (CONCAT "Was " CNT ", now is " (\\REFCNT (CAR TAIL)))))
-                   ((NEQ (\\REFCNT TAIL)
-                         (COND
-                            ((EQ TAIL RESULT)
-                             0)
-                            (T 1)))
-                    (HELP (COND
-                             ((EQ TAIL RESULT)
-                              "Ref cnt of RESTLIST value is not zero")
-                             (T "Ref cnt of RESTLIST tail is not one"))
-                          (\\REFCNT TAIL)))))
-    T))
-)
-
-(RPAQ? RESTLISTCOUNTER
 0)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS RESTLISTCHECK DMACRO (DEFMACRO (N) `(PROGN (RECLAIM)
-                                                     (DORESTLISTTEST1
 (GETRESTARGREFCNTS

-                                                                           ,N)
-                                                            ((OPCODES RESTLIST ,N)
-                                                             NIL KEYARGS)
-                                                            ,N))))
-
-(PUTPROPS \\COMPUTED.FORM MACRO (X (CONS 'PROGN (MAPCAR X (FUNCTION EVAL)))))
-)
-
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD MDSTYPEWORD
 ((NOREFCNT FLAG)
-                              (NIL BITS 15)))
-)
-
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS RESTLISTCOUNTER)
-)
-)
-
-(DEFTEST (RESTLIST :COMPILED)
-   (RESTLISTTESTER
))
-
-
-
-(* \; "Closure tests")

-
-(DEFINEQ
-
-(CLOSURETESTER

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH) |always|
 (CLOSUREMAINTEST

-                                                                                  D))))
-
-(CLOSUREMAINTEST

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET (VALUE)
-             (PUTD 'CLOSUREFN4 (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM DEFPOINTER)
-                                                         |of|
 'CLOSUREFN4CODE)
-                                      CLOSURETEST.ENVIRONMENT))
-             (COND
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (GETD 'CLOSUREFN1)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN1VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN1 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM 
-                                                                                           DEFPOINTER
-                                                                                             )
-                                                                            |of|
 'CLOSUREFN2)
-                                                         CLOSURETEST.ENVIRONMENT)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN2VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN2 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (CLOSUREFN4))
-                             (CLOSUREFN4VALUE
)))
-                 (HELP "CLOSUREFN4 returned the wrong value" VALUE))
-                (T T))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (CLOSUREMAINTEST.RECURSE
 (SUB1 DEPTH))))))
-
-(CLOSUREMAINTEST.RECURSE

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "18-Jul-86 14:07")

-    (CLOSUREMAINTEST
 DEPTH)))
-
-(CLOSUREFNCHECK

-  (LAMBDA (CLOSUREP FUNCALLP)
                            (* |bvm:| "18-Jul-86 14:48")

-    (LET* ((CALLER (\\MYALINK))
-           (PVAR0 (STACKADDBASE (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER))))
-          (COND
-             (CLOSUREP (COND
-                          ((NEQ (\\GETBASEPTR PVAR0 0)
-                                CLOSURETEST.ENVIRONMENT)
-                           (HELP (COND
-                                    (FUNCALLP "FUNCALL of a full closure")
-                                    (T "Call to symbol with Closure definition"))
-                                 " did not store closure environment in pvar0"))))
-             ((|fetch|
 (PVARSLOT BOUND) |of|
 PVAR0)
-              (HELP "FUNCALL of a null closure stored something into pvar0"))))))
-
-(CLOSUREFNCHECK2

-  (LAMBDA NIL
                                            (* |bvm:| "18-Jul-86 14:51")

-                                                             (* \; 
-
                                                           "Nothing really to check for now")

-    NIL))
-
-(CLOSUREFN1

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN1VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN1VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-    (LIST ARG1 ARG2 ARG3 ARG4)))
-
-(CLOSUREFN2

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 T T)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN2VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN2VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-    (LIST ARG4 ARG3 ARG2 ARG1)))
-
-(CLOSUREFN4CODE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:53")

-                                                             (* \; "closure called via FNx")

-    (CLOSUREFNCHECK
 T NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN4VALUE
 ARG1 ARG2 ARG3))))
-
-(CLOSUREFN4VALUE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:38")

-    (LIST ARG2 ARG3 ARG1)))
-)
-
-(RPAQ? CLOSURETEST.DEPTH
 50)
-
-(RPAQ? CLOSURETEST.ENVIRONMENT
 "Closure Environment")
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT)
-)
-
-(DEFTEST (CLOSURES :COMPILED)
-   (CLOSURETESTER
))
-(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
-
-(ADDTOVAR NLAMA
 )
-
-(ADDTOVAR NLAML
 )
-
-(ADDTOVAR LAMA
 DORESTLISTTEST DOFINDKEYTEST)
-)
-(PUTPROPS OPCODES.TEST COPYRIGHT ("ENVOS Corporation" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (6181 12964 (UNWINDTESTER 6191 . 6612) (UNWINDMAINTEST 6614 . 9622) (
-UNWINDMAINTEST.RECURSE 9624 . 9793) (UNWINDCHECK1 9795 . 10093) (UNWINDCHECK2 10095 . 12760) (
-UNWINDCODE 12762 . 12962)) (14040 17299 (UW2.TEST 14050 . 14481) (UW2.RECURSE 14483 . 14722) (
-UW2.TEST.MAIN 14724 . 15381) (UW2.CHECK 15383 . 16991) (UW2.IDENTITY 16993 . 17297)) (17488 19093 (
-FINDKEYTESTER 17498 . 17712) (DOFINDKEYTEST 17714 . 18594) (DOFINDKEYTEST1 18596 . 19091)) (19530 
-23919 (\\RESTLIST.SPLICE.FRAME 19540 . 20874) (RESTLISTTESTER 20876 . 21450) (DORESTLISTTEST 21452 . 
-21821) (GETRESTARGREFCNTS 21823 . 22044) (DORESTLISTTEST1 22046 . 23917)) (24832 30248 (CLOSURETESTER 
-24842 . 25144) (CLOSUREMAINTEST 25146 . 27147) (CLOSUREMAINTEST.RECURSE 27149 . 27305) (CLOSUREFNCHECK
- 27307 . 28110) (CLOSUREFNCHECK2 28112 . 28406) (CLOSUREFN1 28408 . 28897) (CLOSUREFN1VALUE 28899 . 
-29046) (CLOSUREFN2 29048 . 29537) (CLOSUREFN2VALUE 29539 . 29686) (CLOSUREFN4CODE 29688 . 30102) (
-CLOSUREFN4VALUE 30104 . 30246)))))
-STOP

internal/test/Maiko/AUTO/OPCODES.TEST.~3~

@@ -1,792 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED " 8-Nov-88 16:31:16" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;6
 60216  
-
-      |changes| |to:|  (TESTS FREE-VAR-LOOKUP) (VARS OPCODESCOMS)
-
-      |previous| |date:| "27-Oct-88 10:25:24" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;5)
-
-
-; Copyright (c) 1988 by ENVOS Corporation.  All rights reserved.
-
-(PRETTYCOMPRINT OPCODESCOMS)
-
-(RPAQQ OPCODESCOMS
 ((* |;;| "This file contains tests for the various opcodes used in the system.") (VARS (*TEST-FILE-NAME* "OPCODES")) (ADDVARS (DIRECTORIES {ERIS}<TEST>MAIKO>AUX>)) (FILES OPTESTS BBTESTS) (COMS (* \; "BITBLT") (TESTS BITBLT-DIAGONALS BITBLT-SLOPED-LINES)) (COMS (* \; "COPY.N") (TESTS COPY.N COPY.N-UFN)) (COMS (* \; "STORE.N") (TESTS STORE.N STORE.N-UFN)) (COMS (* \; "POP.N") (TESTS POP.N POP.N-UFN)) (COMS (* \; "UNWIND") (TESTS UNWIND-OFF-BY-1-A UNWIND-OFF-BY-1-B) (FNS UNWINDTESTER UNWINDMAINTEST UNWINDMAINTEST.RECURSE UNWINDCHECK1 UNWINDCHECK2 UNWINDCODE) (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS BINDMARKSLOT)) (FNS UW2.TEST UW2.RECURSE UW2.TEST.MAIN UW2.CHECK UW2.IDENTITY) (TESTS UNWIND UNWIND-2)) (COMS (* \; "FINDKEY") (FNS FINDKEYTESTER DOFINDKEYTEST DOFINDKEYTEST1) (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS FINDKEYCHECK)) (TESTS FINDKEY)) (COMS (* \; "RESTLIST") (FNS \\RESTLIST.SPLICE.FRAME RESTLISTTESTER DORESTLISTTEST GETRESTARGREFCNTS DORESTLISTTEST1) (INITVARS (RESTLISTCOUNTER 0)) (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS RESTLISTCHECK \\COMPUTED.FORM) (RECORDS MDSTYPEWORD) (GLOBALVARS RESTLISTCOUNTER)) (TESTS RESTLIST)) (COMS (* \; "Closure tests") (FNS CLOSURETESTER CLOSUREMAINTEST CLOSUREMAINTEST.RECURSE CLOSUREFNCHECK CLOSUREFNCHECK2 CLOSUREFN1 CLOSUREFN1VALUE CLOSUREFN2 CLOSUREFN2VALUE CLOSUREFN4CODE CLOSUREFN4VALUE) (INITVARS (CLOSURETEST.DEPTH 50) (CLOSURETEST.ENVIRONMENT "Closure Environment")) (GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT) (TESTS CLOSURES)) (COMS (* \; "Free-variable lookup") (FNS FVARTEST0 FVARTEST1 FVARTEST2 FVARTEST3) (TESTS FREE-VAR-LOOKUP)) (COMS (* \; "AREF opcode tests") (XCL-USER::VERIFIED-TESTS XCL-USER::AREF1-BIT XCL-USER::AREF1-BYTE XCL-USER::AREF1-WORD XCL-USER::AREF1-SIGNED-WORD XCL-USER::AREF1-FIXP XCL-USER::AREF1-FLOATP XCL-USER::AREF1-STRING-CHAR XCL-USER::AREF1-POINTER XCL-USER::AREF1-XPOINTER XCL-USER::AREF1-PUNT) (* |;;| "array-read and array-write ") (XCL-USER::VERIFIED-TESTS XCL-USER::ARRAY-READ-BIT XCL-USER::ARRAY-READ-BYTE XCL-USER::ARRAY-READ-WORD XCL-USER::ARRAY-READ-SIGNED-WORD XCL-USER::ARRAY-READ-FIXP XCL-USER::ARRAY-READ-FLOATP XCL-USER::ARRAY-READ-THIN-CHAR XCL-USER::ARRAY-READ-FAT-CHAR XCL-USER::ARRAY-READ-POINTER XCL-USER::ARRAY-READ-XPOINTER) (XCL-USER::VERIFIED-TESTS XCL-USER::ARRAY-WRITE-BIT XCL-USER::ARRAY-WRITE-BYTE XCL-USER::ARRAY-WRITE-WORD XCL-USER::ARRAY-WRITE-SIGNED-WORD XCL-USER::ARRAY-WRITE-FIXP XCL-USER::ARRAY-WRITE-FLOATP XCL-USER::ARRAY-WRITE-THIN-CHAR XCL-USER::ARRAY-WRITE-FAT-CHAR XCL-USER::ARRAY-WRITE-POINTER XCL-USER::ARRAY-WRITE-XPOINTER)) (COMS (* |;;| "Boxed opcodes") (XCL-USER::VERIFIED-TESTS XCL-USER::INT+ XCL-USER::FLOAT+ XCL-USER::MIXED+) (XCL-USER::VERIFIED-TESTS XCL-USER::INT- XCL-USER::FLOAT- XCL-USER::MIXED-) (XCL-USER::VERIFIED-TESTS XCL-USER::INT* XCL-USER::FLOAT* XCL-USER::MIXED*) (XCL-USER::VERIFIED-TESTS XCL-USER::INT/ XCL-USER::FLOAT/ XCL-USER::MIXED/) (XCL-USER::VERIFIED-TESTS XCL-USER::INT> XCL-USER::FLOAT> XCL-USER::MIXED>)) (COMS (* |;;| "Unboxed opcodes [scalar]") (* |;;| "Ubfloat1") (XCL-USER::VERIFIED-TESTS XCL-USER::BOX XCL-USER::UNBOX XCL-USER::UBABS XCL-USER::UBNEGATE XCL-USER::UBFIX) (* |;;| "Ubfloat2") (XCL-USER::VERIFIED-TESTS XCL-USER::UB+ XCL-USER::UB- XCL-USER::UB* XCL-USER::UB/ XCL-USER::UB> XCL-USER::UBMAX XCL-USER::UBMIN) (* |;;| "Ubfloat3") (XCL-USER::VERIFIED-TESTS XCL-USER::POLY)) (COMS (* |;;| "Transcendentals --- stress test") (XCL-USER::VERIFIED-TESTS XCL-USER::SIN-TEST XCL-USER::COS-TEST XCL-USER::EXP-TEST XCL-USER::LOG-TEST)) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA DORESTLISTTEST DOFINDKEYTEST))))
-)
-
-
-
-(* |;;| "This file contains tests for the various opcodes used in the system.")

-
-
-(RPAQ *TEST-FILE-NAME*
 "OPCODES")
-
-(ADDTOVAR DIRECTORIES
 {ERIS}<TEST>MAIKO>AUX>)
-
-(FILESLOAD OPTESTS BBTESTS)
-
-
-
-(* \; "BITBLT")

-
-
-(DEFTEST (BITBLT-DIAGONALS :COMPILED) (FOR WIDTH IN (QUOTE (1 2 3 4 5 7 8 9 15 16 17 31 32 33 39 40 41)) ALWAYS (PRINT WIDTH) (* \; "DD") (DIAGONALS WIDTH)))
-
-(DEFTEST (BITBLT-SLOPED-LINES :COMPILED) (FOR I IN (QUOTE (1 3 4 5 7 8 9 15 16 17)) DO (SLOPED-LINES I)) T)
-
-
-
-(* \; "COPY.N")

-
-
-(DEFTEST (COPY.N :COMPILED) (* |;;| "COPY.N  opcode") (EQ :OK (XCL-USER::COPY.N.TEST)))
-
-(DEFTEST COPY.N-UFN (EQ :OK (XCL-USER::COPY.N.TEST T)))
-
-
-
-(* \; "STORE.N")

-
-
-(DEFTEST (STORE.N :COMPILED) (* |;;| "COPY.N  opcode") (EQUAL (QUOTE (5 4 T 2 1)) (XCL-USER::STORE.N.TEST)))
-
-(DEFTEST STORE.N-UFN (* |;;| "STORE.N  opcode") (EQUAL (QUOTE (5 4 T 2 1)) (XCL-USER::STORE.N.TEST T)))
-
-
-
-(* \; "POP.N")

-
-
-(DEFTEST (POP.N :COMPILED) (= 3 (XCL-USER::POP.N.TEST)))
-
-(DEFTEST POP.N-UFN (= 3 (XCL-USER::POP.N.TEST T)))
-
-
-
-(* \; "UNWIND")

-
-
-(DEFTEST UNWIND-OFF-BY-1-A (LET ((F CL:PI)) (EQUAL (LIST (QUOTE SUCCESS) (PROGN (|for| C |in| (UNPACK F) |do| (PRIN1 C)) F)) (QUOTE (SUCCESS 3.1415927)))))
-
-(DEFTEST UNWIND-OFF-BY-1-B (* |;;| "Make sure that UNWIND doesn't mung the binding for F during the for loop.") (LET ((F CL:PI)) (|for| C |in| (UNPACK F) |do| (PRIN1 C)) (AND (FLOATP F) (= F CL:PI))))
-(DEFINEQ
-
-(UNWINDTESTER

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 26-Sep-88 14:11 by bvm")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH)
-       |do|
 (LET ((VALUE (UNWINDMAINTEST
 D (LOGAND D 7))))
-                     (COND
-                        ((NEQ VALUE 'SUCCESS)
-                         (HELP "UNWINDMAINTEST did not return correctly" VALUE)))))
-    T))
-
-(UNWINDMAINTEST

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:10 by bvm")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET ((*B* 3)
-              (*C* 2)
-              (*D* DEPTH))
-             (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-             (LIST (UNWINDCHECK1
 DEPTH)
-                   (LET ((*E* 10)
-                         (*F* 11)
-                         (*G* 12)
-                         (*H* DEPTH))
-                        (DECLARE
 (CL:SPECIAL *E* *F* *G* *H*))
-
-                        (* |;;| "There are 8 pvar slots in this frame (for 7 pvars), so empty stack = 8+2 = 10.  Right now the stack depth is up to 13, because of two bind marks and the value returned from UNWINDCHECK1.")

-
-                        (UNWINDCHECKFAIL T *B* *C* *D* *E* *F* 'PREVPREV 'PREVIOUS-VALUE
-                               (PROGN                        (* \; 
-
                            "Unwind stack to depth 10 + {0,1,3,6} preserving tos when code is even")

-                                      (SELECTQ CODE
-                                          (0                 (* \; "Blow away whole stack")

-                                             ((OPCODES UNWIND 10 0)))
-                                          (1                 (* \; "Same as 0 but keep tos")

-                                             ((OPCODES UNWIND 10 1)))
-                                          (2                 (* \; "Blow away second binding only")

-                                             ((OPCODES UNWIND 11 0)))
-                                          (3                 (* \; "Same as 2 but keep tos")

-                                             ((OPCODES UNWIND 11 1)))
-                                          (4                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 13 0)))
-                                          (5                 (* \; "Same as 4 but keep tos")

-                                             ((OPCODES UNWIND 13 1)))
-                                          (6                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 16 0)))
-                                          ((OPCODES UNWIND 16 1))))
-                               (PROGN                        (* \; 
-
                                     "Check that previous opcode left the stack in the right state")

-                                      (UNWINDCHECK2
 CODE)))))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UNWINDMAINTEST.RECURSE
 (SUB1 DEPTH)
-                 CODE)))))
-
-(UNWINDMAINTEST.RECURSE

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:08 by bvm")

-    (UNWINDMAINTEST
 DEPTH CODE)))
-
-(UNWINDCHECK1

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 13:15")

-                                                             (* \; 
-
                                                "This just prevents compiler from merging specials")

-    NIL))
-
-(UNWINDCHECK2

-  (LAMBDA (CODE)
                                         (* \; "Edited 26-Sep-88 14:10 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.  TOS should be PREVIOUS-VALUE if the UNWIND said to preserve TOS.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD (+ 10 (LOGAND CODE 1)
-                                  (SELECTQ (LRSH CODE 1)
-                                      (0 0)
-                                      (1 1)
-                                      (2 3)
-                                      6))
-                              WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT (UNWINDCODE
 CODE)
-                           " unwound stack "
-                           (COND
-                              ((GREATERP GOODEOS EOS)
-                               "too far")
-                              (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words")))
-             ((AND (ODDP CODE)
-                   (NEQ (\\GETBASEPTR (ADDSTACKBASE (IDIFFERENCE EOS WORDSPERCELL))
-                               0)
-                        'PREVIOUS-VALUE))                    (* \; "Should have preserved tos")

-              (HELP (UNWINDCODE
 CODE)
-                    " did not preserve top of stack")))
-          (|for|
 V |in|
 '(*B* *C* *D* *E* *F* *G* *H*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (SELECTQ (LRSH CODE 1)
-                                                 (0 T)
-                                                 (1 (FMEMB V '(*E* *F* *G* *H*)))
-                                                 NIL))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT (UNWINDCODE
 CODE)
-                                                         " left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT (UNWINDCODE
 CODE)
-                                    " left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from UNWINDMAINTEST because the UNWIND there has ruined its stack")

-
-                 (RETFROM 'UNWINDMAINTEST 'SUCCESS)))))
-
-(UNWINDCODE

-  (LAMBDA (CODE)
                                         (* |bvm:| "21-Jul-86 15:34")

-    (CONCAT "UNWIND." (PLUS 10 (LOGAND CODE 1))
-           "."
-           (LRSH CODE 1))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD BINDMARKSLOT
 ((BINDMARKP FLAG) (NIL BITS 15)) (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD) (BINDLASTPVAR WORD)))
- (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN (* |Value| |stored| |in| |high| |half| |is| |one's| |complement| |of| |number| |of| |values| |bound|) (LOGXOR (|fetch| BINDNEGVALUES |of| DATUM) 65535)))))
-)
-)
-)
-(DEFINEQ
-
-(UW2.TEST

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 15:00 by vanmelle")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (UW2.TEST.MAIN
))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UW2.RECURSE
 (SUB1 DEPTH))))))
-
-(UW2.RECURSE

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 14:56 by vanmelle")

-                                                             (* \; "To foil compiler")

-    (UW2.TEST
 DEPTH)))
-
-(UW2.TEST.MAIN

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 20-Oct-88 15:49 by bvm")

-    (LET ((*B* 3)
-          (*C* 2.4)
-          (*D* DEPTH))
-         (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-         (LIST (UW2.IDENTITY
 'TOS)
-               (LET ((*E* 3.5))
-                    (DECLARE
 (CL:SPECIAL *E*))
-
-                    (* |;;| "There are 4 pvar slots in this frame, so empty stack = 4+2 = 6.  Right now the stack depth is up to 9, because of 2 bind marks and the value from NILL.")

-
-                    (UNWINDCHECKFAIL T NIL ((OPCODES UNWIND 9 0))
-                           (UW2.CHECK
)))))))
-
-(UW2.CHECK

-  (LAMBDA NIL
                                            (* \; "Edited 20-Oct-88 15:49 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD 9 WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT "Unwound stack " (COND
-                                                ((GREATERP GOODEOS EOS)
-                                                 "too far")
-                                                (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words"))))
-          (|for|
 V |in|
 '(*B* *C* *D* *E*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (AND NIL (EQ V '*E*)))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT "UNWIND left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT "UNWIND left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from test because the UNWIND there has confused its stack")

-
-                 (RETFROM 'UW2.TEST.MAIN 'SUCCESS)))))
-
-(UW2.IDENTITY

-  (LAMBDA (X)
                                            (* \; "Edited 20-Oct-88 15:19 by bvm")

-                                                             (* \; 
-
                                                           "Identity compiler doesn't know about")

-    X))
-)
-
-(DEFTEST (UNWIND :COMPILED) (UNWINDTESTER))
-
-(DEFTEST (UNWIND-2 :COMPILED) (FOR I FROM 0 TO 100 ALWAYS (EQ (QUOTE SUCCESS) (UW2.TEST I))))
-
-
-
-(* \; "FINDKEY")

-
-(DEFINEQ
-
-(FINDKEYTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "14-Jul-86 17:54")

-
-(* |;;;| "Test the opcode FINDKEY")

-
-    (DOFINDKEYTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)))
-
-(DOFINDKEYTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (FINDKEYCHECK 1 ||)
-         (FINDKEYCHECK 2 ||)
-         (FINDKEYCHECK 3 ||)
-         (FINDKEYCHECK 4 ||)
-         (FINDKEYCHECK 5 ||)
-         (FINDKEYCHECK 6 ||)
-         (FINDKEYCHECK 7 ||)
-         (FINDKEYCHECK 8 ||)
-         (FINDKEYCHECK 1 KEYB)
-         (FINDKEYCHECK 2 KEYB)
-         (FINDKEYCHECK 3 KEYB)
-         (FINDKEYCHECK 4 KEYB)
-         (FINDKEYCHECK 5 KEYB)
-         (FINDKEYCHECK 6 KEYB)
-         (FINDKEYCHECK 7 KEYB)
-         (FINDKEYCHECK 8 KEYB)
-         (FINDKEYCHECK 1 KEYC)
-         (FINDKEYCHECK 2 KEYC)
-         (FINDKEYCHECK 3 KEYC)
-         (FINDKEYCHECK 4 KEYC)
-         (FINDKEYCHECK 5 KEYC)
-         (FINDKEYCHECK 6 KEYC)
-         (FINDKEYCHECK 7 KEYC)
-         (FINDKEYCHECK 8 KEYC))))
-
-(DOFINDKEYTEST1

-  (LAMBDA (RESULT N KEY)
                                 (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (LET ((ANSWER (|for|
 I |from|
 N |by|
 2 |to|
 KEYARGS
-                     |when|
 (EQ KEY (ARG KEYARGS I)) |do|
 (RETURN (ADD1 I)))))
-         (COND
-            ((NEQ ANSWER RESULT)
-             (HELP (CONCAT "FINDKEY." N " returned " RESULT " instead of " ANSWER " for ")
-                   KEY))
-            (T T)))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS FINDKEYCHECK DMACRO (DEFMACRO (N KEY) (BQUOTE (DOFINDKEYTEST1 ((OPCODES FINDKEY (\\\, N)) (QUOTE (\\\, KEY))) (\\\, N) (QUOTE (\\\, KEY))))))
-)
-)
-
-(DEFTEST (FINDKEY :COMPILED) (FINDKEYTESTER))
-
-
-
-(* \; "RESTLIST")

-
-(DEFINEQ
-
-(\\RESTLIST.SPLICE.FRAME

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:13")

-
-(* |;;;| "If caller is fast, so its BF is contiguous with its caller's FX, then adjust pointers so that its first ivar goes back on it's caller's fx, and back up pc")

-
-    (UNINTERRUPTABLY
-        (LET ((CALLER (\\MYALINK))
-              CALLER2 IVAR BF)
-             (COND
-                ((AND (|fetch|
 (FX FASTP) |of|
 CALLER)
-                      (EQ (SETQ IVAR (|fetch|
 (BF IVAR) |of|
 (SETQ BF (|fetch|

-                                                                               (FX DUMMYBF)
-                                                                                 |of|
 CALLER))))
-                          (|fetch|
 (FX NEXTBLOCK) |of|
 (SETQ CALLER2 (|fetch|

-                                                                              (FX ALINK) |of|

-                                                                                         CALLER)))))
-                 (|replace|
 (BF IVAR) |of|
 BF |with|
 (|add|
 IVAR WORDSPERCELL))
-                 (|replace|
 (FX NEXTBLOCK) |of|
 CALLER2 |with|
 IVAR)
-                 (|add|
 (|fetch|
 (FX PC) |of|
 CALLER2)
-                        -2)
-                 T))))))
-
-(RESTLISTTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:28")

-
-(* |;;;| "Test the opcode RESTLIST")

-
-    (AND (DORESTLISTTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)
-         (DORESTLISTTEST
 '(||)
-                '(VALA)
-                '(KEYB)
-                'VALB
-                '(KEYC)
-                '(VALC))
-         (DORESTLISTTEST
)
-         (\\COMPUTED.FORM (CONS 'DORESTLISTTEST (|for|
 I |from|
 1 |to|
 200
-                                                   |collect|
 `',(LIST I)))))))
-
-(DORESTLISTTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:39")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (RESTLISTCHECK 1)
-         (RESTLISTCHECK 2)
-         (RESTLISTCHECK 3)
-         (RESTLISTCHECK 4)
-         (RESTLISTCHECK 5)
-         (RESTLISTCHECK 6)
-         (RESTLISTCHECK 7)
-         (RESTLISTCHECK 8))))
-
-(GETRESTARGREFCNTS

-  (LAMBDA (N)
-    (DECLARE
 (USEDFREE KEYARGS))
                     (* |bvm:| "18-Jul-86 15:01")

-    (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (\\REFCNT (ARG KEYARGS I)))))
-
-(DORESTLISTTEST1

-  (LAMBDA (REFCNTS RESULT N)
                             (* |bvm:| "21-Jul-86 17:22")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (COND
-       ((OR (NOT (EQLENGTH RESULT (IMAX (IDIFFERENCE KEYARGS (SUB1 N))
-                                        0)))
-            (|for|
 R |in|
 RESULT |as|
 I |from|
 N |to|
 KEYARGS
-               |thereis|
 (NEQ R (ARG KEYARGS I))))
-        (HELP (CONCAT "RESTLIST." N " returned " RESULT " instead of "
-                     (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (ARG KEYARGS I))))))
-    (|for|
 TAIL |on|
 RESULT |as|
 CNT |in|
 REFCNTS |as|
 I |from|
 1
-       |do|
 (COND
-                   ((AND (NEQ (\\REFCNT (CAR TAIL))
-                              (ADD1 CNT))
-                         (NOT (|fetch|
 (MDSTYPEWORD NOREFCNT)
-                                 |of|
 (\\ADDBASE |\\MDSTypeTable| (LRSH (|fetch|
 (POINTER
-                                                                                          PAGE#)
-                                                                               |of|
 (CAR TAIL))
-                                                                            1)))))
-                    (HELP (CONCAT "Ref cnt of " I "th RESTLIST element was not incremented")
-                          (CONCAT "Was " CNT ", now is " (\\REFCNT (CAR TAIL)))))
-                   ((NEQ (\\REFCNT TAIL)
-                         (COND
-                            ((EQ TAIL RESULT)
-                             0)
-                            (T 1)))
-                    (HELP (COND
-                             ((EQ TAIL RESULT)
-                              "Ref cnt of RESTLIST value is not zero")
-                             (T "Ref cnt of RESTLIST tail is not one"))
-                          (\\REFCNT TAIL)))))
-    T))
-)
-
-(RPAQ? RESTLISTCOUNTER
 0)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS RESTLISTCHECK DMACRO (DEFMACRO (N) (BQUOTE (PROGN (RECLAIM) (DORESTLISTTEST1 (GETRESTARGREFCNTS (\\\, N)) ((OPCODES RESTLIST (\\\, N)) NIL KEYARGS) (\\\, N))))))
-
-(PUTPROPS \\COMPUTED.FORM MACRO (X (CONS (QUOTE PROGN) (MAPCAR X (FUNCTION EVAL)))))
-)
-
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD MDSTYPEWORD
 ((NOREFCNT FLAG) (NIL BITS 15)))
-)
-
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS RESTLISTCOUNTER)
-)
-)
-
-(DEFTEST (RESTLIST :COMPILED) (RESTLISTTESTER))
-
-
-
-(* \; "Closure tests")

-
-(DEFINEQ
-
-(CLOSURETESTER

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH) |always|
 (CLOSUREMAINTEST

-                                                                                  D))))
-
-(CLOSUREMAINTEST

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET (VALUE)
-             (PUTD 'CLOSUREFN4 (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM DEFPOINTER)
-                                                         |of|
 'CLOSUREFN4CODE)
-                                      CLOSURETEST.ENVIRONMENT))
-             (COND
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (GETD 'CLOSUREFN1)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN1VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN1 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM 
-                                                                                           DEFPOINTER
-                                                                                             )
-                                                                            |of|
 'CLOSUREFN2)
-                                                         CLOSURETEST.ENVIRONMENT)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN2VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN2 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (CLOSUREFN4))
-                             (CLOSUREFN4VALUE
)))
-                 (HELP "CLOSUREFN4 returned the wrong value" VALUE))
-                (T T))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (CLOSUREMAINTEST.RECURSE
 (SUB1 DEPTH))))))
-
-(CLOSUREMAINTEST.RECURSE

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "18-Jul-86 14:07")

-    (CLOSUREMAINTEST
 DEPTH)))
-
-(CLOSUREFNCHECK

-  (LAMBDA (CLOSUREP FUNCALLP)
                            (* |bvm:| "18-Jul-86 14:48")

-    (LET* ((CALLER (\\MYALINK))
-           (PVAR0 (STACKADDBASE (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER))))
-          (COND
-             (CLOSUREP (COND
-                          ((NEQ (\\GETBASEPTR PVAR0 0)
-                                CLOSURETEST.ENVIRONMENT)
-                           (HELP (COND
-                                    (FUNCALLP "FUNCALL of a full closure")
-                                    (T "Call to symbol with Closure definition"))
-                                 " did not store closure environment in pvar0"))))
-             ((|fetch|
 (PVARSLOT BOUND) |of|
 PVAR0)
-              (HELP "FUNCALL of a null closure stored something into pvar0"))))))
-
-(CLOSUREFNCHECK2

-  (LAMBDA NIL
                                            (* |bvm:| "18-Jul-86 14:51")

-                                                             (* \; 
-
                                                           "Nothing really to check for now")

-    NIL))
-
-(CLOSUREFN1

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN1VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN1VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-    (LIST ARG1 ARG2 ARG3 ARG4)))
-
-(CLOSUREFN2

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 T T)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN2VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN2VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-    (LIST ARG4 ARG3 ARG2 ARG1)))
-
-(CLOSUREFN4CODE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:53")

-                                                             (* \; "closure called via FNx")

-    (CLOSUREFNCHECK
 T NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN4VALUE
 ARG1 ARG2 ARG3))))
-
-(CLOSUREFN4VALUE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:38")

-    (LIST ARG2 ARG3 ARG1)))
-)
-
-(RPAQ? CLOSURETEST.DEPTH
 50)
-
-(RPAQ? CLOSURETEST.ENVIRONMENT
 "Closure Environment")
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT)
-)
-
-(DEFTEST (CLOSURES :COMPILED) (CLOSURETESTER))
-
-
-
-(* \; "Free-variable lookup")

-
-(DEFINEQ
-
-(FVARTEST0

-(LAMBDA NIL (* \; "Edited  2-Aug-88 23:04 by FS") (SETTOPVAL (QUOTE TOPLEVEL1) 1) (SETTOPVAL (QUOTE TOPLEVEL2) 2) (SETTOPVAL (QUOTE NITERS) 3) (EQ (ITIMES NITERS 334) (FVARTEST1 100 200 4)))
-)
-
-(FVARTEST1

-(LAMBDA (IVAR1 IVAR2 DEPTH) (* \; "Edited  2-Aug-88 23:02 by FS") (* |;;| "Recurse DEPTH times and then call FVARTEST2 to test free variable lookup.") (LET (PVAR1) (* |;;| "This block is here so that name table scanning will find it, but must skip it.  PRINT so the compiler won't throw the block away.") (SETQ PVAR1 DEPTH) (PRINTOUT T "AT DEPTH " PVAR1 T)) (LET (PVAR1 PVAR2) (SETQ PVAR1 10) (SETQ PVAR2 20) (COND ((<= DEPTH 0) (FVARTEST2 4)) (T (FVARTEST1 IVAR1 IVAR2 (SUB1 DEPTH))))))
-)
-
-(FVARTEST2

-(LAMBDA (DEPTH) (* \; "Edited  2-Aug-88 22:56 by FS") (* |;;| "Recurse DEPTH times and then freely reference IVars, PVars, Globals.") (* |;;| "") (* |;;| "It needs to search past its own frames (the vars are unbound), and past FVARTEST1's frames for the globals.") (* |;;| "") (* |;;| "It will  find IVARx, PVARx in FVARTEST1's frames.") (* |;;| "") (* |;;| " Loop based on the freely referenced NITERS, to test FVAR  caching.") (PROG (NAMETBLE1 NAMETBLE2 TOTAL) (COND ((<= DEPTH 0) (SETQ TOTAL 0) (|for| I |from| 1 |to| NITERS |do| (SETQ TOTAL (+ TOTAL IVAR1 IVAR2 PVAR1 PVAR2 TOPLEVEL1 TOPLEVEL2 (FVARTEST3)))) (RETURN TOTAL)) (T (RETURN (FVARTEST2 (SUB1 DEPTH)))))))
-)
-
-(FVARTEST3

-(LAMBDA NIL (* \; "Edited  2-Aug-88 22:54 by FS") (* |;;| "Should find TOPLEVEL1 in FVARTEST2's frame (no way to test if this is really happening, but it should test a branch of the C code.") TOPLEVEL1)
-)
-)
-
-(DEFTEST FREE-VAR-LOOKUP (FVARTEST0))
-
-
-
-(* \; "AREF opcode tests")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-BIT "Opcode aref1, type (unsigned-byte 1)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 1)) :INITIAL-CONTENTS (QUOTE (0 1 0 1)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 1)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-BYTE "Opcode aref1, type (unsigned-byte 8)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :INITIAL-CONTENTS (QUOTE (0 34 56 255 23)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-WORD "Opcode aref1, type (unsigned-byte 16)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 16)) :INITIAL-CONTENTS (QUOTE (0 34 255 65535 23)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 16)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-SIGNED-WORD "Opcode aref1, type (signed-byte 16)" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:SIGNED-BYTE 16)) :INITIAL-CONTENTS (QUOTE (0 -34 255 -32768 23))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-FIXP "Opcode aref1, type (signed-byte 32)" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:SIGNED-BYTE 32)) :INITIAL-CONTENTS (QUOTE (0 -34 258 -65538 2147483647))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-FLOATP "Opcode aref1, type single-float" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE CL:SINGLE-FLOAT) :INITIAL-CONTENTS (QUOTE (0.0 -34.0 3.456756E+35 -5.768E-34 5.4524))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-STRING-CHAR "Opcode aref1, type string-char" (LET ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 3 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :INITIAL-CONTENTS (QUOTE (#\Space #\a #\b)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 3 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :FATP T :INITIAL-CONTENTS (QUOTE (#\Space #\Greek-0 #\Greek-32))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 3) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-POINTER "Opcode aref1, type t" (LET* ((XCL-USER::LST (LIST 0 (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B)) 3.4 (QUOTE XCL-USER::C) (CONS (QUOTE XCL-USER::D) (QUOTE XCL-USER::E)))) (CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE T :INITIAL-CONTENTS XCL-USER::LST))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CONS (CL:AREF CL:ARRAY XCL-USER::I) (\\REFCNT (CL:AREF CL:ARRAY XCL-USER::I))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-XPOINTER "Opcode aref1, type il:xpointer" (LET* ((XCL-USER::LST (LIST 0 (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B)) 3.4 (QUOTE XCL-USER::C) (CONS (QUOTE XCL-USER::D) (QUOTE XCL-USER::E)))) (CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE XPOINTER) :INITIAL-CONTENTS XCL-USER::LST))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CONS (CL:AREF CL:ARRAY XCL-USER::I) (\\REFCNT (CL:AREF CL:ARRAY XCL-USER::I))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-PUNT "Opcode aref1, punt cases" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :DISPLACED-TO (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :INITIAL-CONTENTS (QUOTE (#\a #\b #\c #\d))))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE T :ADJUSTABLE T :INITIAL-CONTENTS (QUOTE (0 XCL-USER::A XCL-USER::B (XCL-USER::A . XCL-USER::B))))) (XCL-USER::ARRAY-3 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :READ-ONLY-P T :INITIAL-CONTENTS (QUOTE (0 1 2 3))))) (* |;;| "aref1 should punt on all these cases") (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-3 XCL-USER::I))))))
-
-
-
-(* |;;| "array-read and array-write ")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-BIT "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 1)" (CL:FLET ((XCL-USER::ARRAY-READ-BIT (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 0 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 8 0))) (\\PUTBASEBYTE XCL-USER::BASE 0 160) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-BIT XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-BYTE "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 8)" (CL:FLET ((XCL-USER::ARRAY-READ-BYTE (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 3 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 3))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 4)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEBYTE XCL-USER::BASE XCL-USER::I (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-BYTE XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-WORD "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 16)" (CL:FLET ((XCL-USER::ARRAY-READ-WORD (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 4 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 4))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 65535)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-WORD XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-SIGNED-WORD "Opcode ARRAYREAD (MISC3 9), type (signed-byte 16)" (CL:FLET ((XCL-USER::ARRAY-READ-SIGNED-WORD (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 20 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 20))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 255 -32768)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (\\LOLOC (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-SIGNED-WORD XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FIXP "Opcode ARRAYREAD (MISC3 9), type (signed-byte 32)" (CL:FLET ((XCL-USER::ARRAY-READ-FIXP (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 22 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 22))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 65536 -2147483648)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEFIXP XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FIXP XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FLOATP "Opcode ARRAYREAD (MISC3 9), type single-float" (CL:FLET ((XCL-USER::ARRAY-READ-FLOATP (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 54 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 54))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0.0 -23.0 3.4456E+24 -4.562435E-12)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEFLOATP XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FLOATP XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-THIN-CHAR "Opcode ARRAYREAD (MISC3 9), type string-char" (CL:FLET ((XCL-USER::ARRAY-READ-THIN-CHAR (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 67 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 67))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEBYTE XCL-USER::BASE XCL-USER::I (CL:CHAR-CODE (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-THIN-CHAR XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FAT-CHAR "Opcode ARRAYREAD (MISC3 9), type fat-string-char" (CL:FLET ((XCL-USER::ARRAY-READ-FAT-CHAR (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 68 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 68))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (CL:CHAR-CODE (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FAT-CHAR XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-POINTER "Opcode ARRAYREAD (MISC3 9), type t" (CL:FLET ((XCL-USER::ARRAY-READ-POINTER (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 38 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 38))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (2 #\c 2.3 (XCL-USER::A . XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\RPLPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-POINTER XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-XPOINTER "Opcode ARRAYREAD (MISC3 9), type il:xpointer" (CL:FLET ((XCL-USER::ARRAY-READ-XPOINTER (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 86 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 86))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (2 #\c 2.3 (XCL-USER::A . XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-XPOINTER XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-BIT "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 1)" (CL:FLET ((XCL-USER::ARRAY-WRITE-BIT (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 0 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 8 0))) (\\PUTBASEBYTE XCL-USER::BASE 0 160) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (1 0 1 0)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-BIT (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (LET ((BYTE (\\GETBASEBYTE XCL-USER::BASE 0))) (LIST (LDB (BYTE 1 7) BYTE) (LDB (BYTE 1 6) BYTE) (LDB (BYTE 1 5) BYTE) (LDB (BYTE 1 4) BYTE))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-BYTE "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 8)" (CL:FLET ((XCL-USER::ARRAY-WRITE-BYTE (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 3 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 3))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 4)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-BYTE (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEBYTE XCL-USER::BASE XCL-USER::I)))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-WORD "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 16)" (CL:FLET ((XCL-USER::ARRAY-WRITE-WORD (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 4 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 4))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 65535)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-WORD (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASE XCL-USER::BASE XCL-USER::I)))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-SIGNED-WORD "Opcode ARRAYWRITE (MISC4 7), type (signed-byte 16)" (CL:FLET ((XCL-USER::ARRAY-WRITE-SIGNED-WORD (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 20 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 20))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 255 -32768)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-SIGNED-WORD (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (LET ((XCL-USER::WORD (\\GETBASE XCL-USER::BASE XCL-USER::I))) (CL:IF (> XCL-USER::WORD 32767) (\\VAG2 15 XCL-USER::WORD) XCL-USER::WORD))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FIXP "Opcode ARRAYWRITE (MISC4 7), type (signed-byte 32)" (CL:FLET ((XCL-USER::ARRAY-WRITE-FIXP (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 22 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 22))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 65536 -2147483648)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FIXP (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEFIXP XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FLOATP "Opcode ARRAYWRITE (MISC4 7), type single-float" (CL:FLET ((XCL-USER::ARRAY-WRITE-FLOATP (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 54 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 54))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0.0 -23.0 3.4456E+24 -4.562435E-12)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FLOATP (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEFLOATP XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-THIN-CHAR "Opcode ARRAYWRITE (MISC4 7), type thin-string-char" (CL:FLET ((XCL-USER::ARRAY-WRITE-THIN-CHAR (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 67 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 67))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-THIN-CHAR (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:CODE-CHAR (\\GETBASEBYTE XCL-USER::BASE XCL-USER::I))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FAT-CHAR "Opcode ARRAYWRITE (MISC4 7), type fat-string-char" (CL:FLET ((XCL-USER::ARRAY-WRITE-FAT-CHAR (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 68 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 68))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FAT-CHAR (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:CODE-CHAR (\\GETBASE XCL-USER::BASE XCL-USER::I))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-POINTER "Opcode ARRAYWRITE (MISC4 7), type t" (CL:FLET ((XCL-USER::ARRAY-WRITE-POINTER (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 38 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 38))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (LIST 2 #\c (QUOTE XCL-USER::A) (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-POINTER (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CONS (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1)) (\\REFCNT (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-XPOINTER "Opcode ARRAYWRITE (MISC4 7), type il:xpointer" (CL:FLET ((XCL-USER::ARRAY-WRITE-XPOINTER (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 86 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 86))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (LIST 2 #\c (QUOTE XCL-USER::A) (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-XPOINTER (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CONS (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1)) (\\REFCNT (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))))
-
-
-
-(* |;;| "Boxed opcodes")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT+ "Opcodes IPLUS,FPLUS, and PLUS, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 -3 9834756987354 21845 -54))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT+ "Opcodes IPLUS,FPLUS, and PLUS, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 -3.0 -3.4028235E+38 21845.0 -54.0))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED+ "Opcodes IPLUS,FPLUS, and PLUS, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 -3 1/3 9834756987354 21845 -54))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 3 9834756987354 21845 -54))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 3.0 3.4028235E+38 21845.0 -54.0))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 3 1/3 9834756987354 21845 -54))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT* "Opcodes ITIMES,FTIMES, and TIMES, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45 345235424 0 23 21845))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT* "Opcodes ITIMES,FTIMES, and TIMES, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45.0 0.0 1.1342745E+38 -21845.0))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED* "Opcodes ITIMES,FTIMES, and TIMES, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45 1/3 345235424 0 23 21845))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args integer" (LET ((XCL-USER::X 21845)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1 345235424 -45))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args float" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, args mixed" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1 4/3 -1345619432 45))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 -45 345235424 22000))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 22000.0))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1/3 -45 5498457654 22000))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-
-
-(* |;;| "Unboxed opcodes [scalar]")

-
-
-
-
-(* |;;| "Ubfloat1")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::BOX "Opcode BOX (UBFLOAT1 0)" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE ((16256 . 0) (0 . 0) (49716 . 0) (26309 . 45156)))) (XCL:COLLECT (\\FLOATBOX (\\VAG2 (CAR XCL-USER::X) (CDR XCL-USER::X)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UNBOX "Opcode UNBOX (UBFLOAT1 1)" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1.0 0.0 -45.0 4.6678E+23))) (LET ((XCL-USER::Y (\\FLOATUNBOX XCL-USER::X))) (XCL:COLLECT (CONS (\\HILOC XCL-USER::Y) (\\LOLOC XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBABS "Opcode UFABS (UBFLOAT1 2)" (CL:FLET ((XCL-USER::UBABS (XCL-USER::X) (\\FLOATBOX ((OPCODES UBFLOAT1 2) (\\FLOATUNBOX XCL-USER::X))))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBABS XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBNEGATE "Opcode UFNEGATE (UBFLOAT1 3)" (CL:FLET ((XCL-USER::UBNEGATE (XCL-USER::X) (\\FLOATBOX ((OPCODES UBFLOAT1 3) (\\FLOATUNBOX XCL-USER::X))))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBNEGATE XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBFIX "Opcode UFIX (UBFLOAT1 4)" (CL:FLET ((XCL-USER::UBFIX (XCL-USER::X) ((OPCODES UBFLOAT1 4) (\\FLOATUNBOX XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBFIX XCL-USER::X))))))
-
-
-
-(* |;;| "Ubfloat2")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB+ "Opcode UFADD (UBFLOAT2 0)" (CL:FLET ((XCL-USER::UB+ (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 0) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 -3.0 -3.4028235E+38 21845.0 3))) (XCL:COLLECT (XCL-USER::UB+ XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB- "Opcode UFSUB (UBFLOAT2 1)" (CL:FLET ((XCL-USER::UB- (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((* |;;| "ub -") (OPCODES UBFLOAT2 1) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 3.0 3.4028235E+38 21845 1/3 -54.0))) (XCL:COLLECT (XCL-USER::UB- XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB* "Opcode UFMULT (UBFLOAT2 3)" (CL:FLET ((XCL-USER::UB* (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 3) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45.0 0.0 1.1342745E+38 -21845.0))) (XCL:COLLECT (XCL-USER::UB* XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB/ "Opcode UFDIV (UBFLOAT2 4)" (CL:FLET ((XCL-USER::UB/ (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 4) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (0.001 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (XCL:COLLECT (XCL-USER::UB/ XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB> "Opcode UFGREAT (UBFLOAT2 5)" (CL:FLET ((XCL-USER::UB> (XCL-USER::X XCL-USER::Y) ((OPCODES UBFLOAT2 5) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y)))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UB> XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBMAX "Opcode UFMAX (UBFLOAT2 6)" (CL:FLET ((XCL-USER::UBMAX (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 6) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UBMAX XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBMIN "Opcode UFMAX (UBFLOAT2 7)" (CL:FLET ((XCL-USER::UBMIN (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 7) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UBMIN XCL-USER::X XCL-USER::Y)))))))
-
-
-
-(* |;;| "Ubfloat3")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::POLY "Opcode POLY (UBFLOAT3 0)" (CL:FLET ((XCL-USER::POLY (XCL-USER::X XCL-USER::BASE XCL-USER::SIZE) (\\FLOATBOX ((OPCODES UBFLOAT3 0) (\\FLOATUNBOX XCL-USER::X) XCL-USER::BASE XCL-USER::SIZE)))) (LET* ((CL:ARRAY (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:SINGLE-FLOAT) :INITIAL-CONTENTS (QUOTE (1.0 2.0 3.0 4.0)))) (XCL-USER::BASE (%ARRAY-BASE CL:ARRAY))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::PAIR (QUOTE ((1.0 . 3) (1.0 . 1) (3.5 . 3)))) (XCL:COLLECT (XCL-USER::POLY (CAR XCL-USER::PAIR) XCL-USER::BASE (CDR XCL-USER::PAIR))))))))
-
-
-
-(* |;;| "Transcendentals --- stress test")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::SIN-TEST "Function SIN" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (0.0 1/3 -1.2 12.6))) (XCL:COLLECT (CL:SIN (CL:* CL:PI XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::COS-TEST "Function COS" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (0.0 1/3 -1.2 12.6))) (XCL:COLLECT (CL:COS (CL:* CL:PI XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::EXP-TEST "Function EXP" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1.0 20.5 1/3 -5.2))) (XCL:COLLECT (CL:EXP XCL-USER::X)))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::LOG-TEST "Function LOG" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (2.7182817 -2.0 453.78))) (XCL:COLLECT (CL:LOG XCL-USER::X)))))
-(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
-
-(ADDTOVAR NLAMA
 )
-
-(ADDTOVAR NLAML
 )
-
-(ADDTOVAR LAMA
 DORESTLISTTEST DOFINDKEYTEST)
-)
-(PUTPROPS OPCODES.TEST COPYRIGHT ("ENVOS Corporation" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (5504 12287 (UNWINDTESTER 5514 . 5935) (UNWINDMAINTEST 5937 . 8945) (
-UNWINDMAINTEST.RECURSE 8947 . 9116) (UNWINDCHECK1 9118 . 9416) (UNWINDCHECK2 9418 . 12083) (UNWINDCODE
- 12085 . 12285)) (12688 15947 (UW2.TEST 12698 . 13129) (UW2.RECURSE 13131 . 13370) (UW2.TEST.MAIN 
-13372 . 14029) (UW2.CHECK 14031 . 15639) (UW2.IDENTITY 15641 . 15945)) (16113 17718 (FINDKEYTESTER 
-16123 . 16337) (DOFINDKEYTEST 16339 . 17219) (DOFINDKEYTEST1 17221 . 17716)) (18008 22397 (
-\\RESTLIST.SPLICE.FRAME 18018 . 19352) (RESTLISTTESTER 19354 . 19928) (DORESTLISTTEST 19930 . 20299) (
-GETRESTARGREFCNTS 20301 . 20522) (DORESTLISTTEST1 20524 . 22395)) (22989 28405 (CLOSURETESTER 22999 . 
-23301) (CLOSUREMAINTEST 23303 . 25304) (CLOSUREMAINTEST.RECURSE 25306 . 25462) (CLOSUREFNCHECK 25464
- . 26267) (CLOSUREFNCHECK2 26269 . 26563) (CLOSUREFN1 26565 . 27054) (CLOSUREFN1VALUE 27056 . 27203) (
-CLOSUREFN2 27205 . 27694) (CLOSUREFN2VALUE 27696 . 27843) (CLOSUREFN4CODE 27845 . 28259) (
-CLOSUREFN4VALUE 28261 . 28403)) (28678 30312 (FVARTEST0 28688 . 28895) (FVARTEST1 28897 . 29401) (
-FVARTEST2 29403 . 30089) (FVARTEST3 30091 . 30310)))))
-STOP

internal/test/Maiko/AUTO/OPCODES.TEST.~4~

@@ -1,803 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED " 8-Nov-88 17:10:36" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;7
 60631  
-
-      |changes| |to:|  (XCL-USER::VERIFIED-TESTS XCL-USER::INT+) (TESTS ERROR+ ERROR/T ERROR/0 NO-ERROR-0/0 ERROR-T/X FREE-VAR-LOOKUP)
- (VARS OPCODESCOMS)
-
-      |previous| |date:| "27-Oct-88 10:25:24" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;5)
-
-
-; Copyright (c) 1988 by ENVOS Corporation.  All rights reserved.
-
-(PRETTYCOMPRINT OPCODESCOMS)
-
-(RPAQQ OPCODESCOMS
 ((* |;;| "This file contains tests for the various opcodes used in the system.") (VARS (*TEST-FILE-NAME* "OPCODES")) (ADDVARS (DIRECTORIES {ERIS}<TEST>MAIKO>AUX>)) (FILES OPTESTS BBTESTS) (COMS (* \; "BITBLT") (TESTS BITBLT-DIAGONALS BITBLT-SLOPED-LINES)) (COMS (* \; "COPY.N") (TESTS COPY.N COPY.N-UFN)) (COMS (* \; "STORE.N") (TESTS STORE.N STORE.N-UFN)) (COMS (* \; "POP.N") (TESTS POP.N POP.N-UFN)) (COMS (* \; "UNWIND") (TESTS UNWIND-OFF-BY-1-A UNWIND-OFF-BY-1-B) (FNS UNWINDTESTER UNWINDMAINTEST UNWINDMAINTEST.RECURSE UNWINDCHECK1 UNWINDCHECK2 UNWINDCODE) (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS BINDMARKSLOT)) (FNS UW2.TEST UW2.RECURSE UW2.TEST.MAIN UW2.CHECK UW2.IDENTITY) (TESTS UNWIND UNWIND-2)) (COMS (* \; "FINDKEY") (FNS FINDKEYTESTER DOFINDKEYTEST DOFINDKEYTEST1) (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS FINDKEYCHECK)) (TESTS FINDKEY)) (COMS (* \; "RESTLIST") (FNS \\RESTLIST.SPLICE.FRAME RESTLISTTESTER DORESTLISTTEST GETRESTARGREFCNTS DORESTLISTTEST1) (INITVARS (RESTLISTCOUNTER 0)) (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS RESTLISTCHECK \\COMPUTED.FORM) (RECORDS MDSTYPEWORD) (GLOBALVARS RESTLISTCOUNTER)) (TESTS RESTLIST)) (COMS (* \; "Closure tests") (FNS CLOSURETESTER CLOSUREMAINTEST CLOSUREMAINTEST.RECURSE CLOSUREFNCHECK CLOSUREFNCHECK2 CLOSUREFN1 CLOSUREFN1VALUE CLOSUREFN2 CLOSUREFN2VALUE CLOSUREFN4CODE CLOSUREFN4VALUE) (INITVARS (CLOSURETEST.DEPTH 50) (CLOSURETEST.ENVIRONMENT "Closure Environment")) (GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT) (TESTS CLOSURES)) (COMS (* \; "Free-variable lookup") (FNS FVARTEST0 FVARTEST1 FVARTEST2 FVARTEST3) (TESTS FREE-VAR-LOOKUP)) (COMS (* \; "AREF opcode tests") (XCL-USER::VERIFIED-TESTS XCL-USER::AREF1-BIT XCL-USER::AREF1-BYTE XCL-USER::AREF1-WORD XCL-USER::AREF1-SIGNED-WORD XCL-USER::AREF1-FIXP XCL-USER::AREF1-FLOATP XCL-USER::AREF1-STRING-CHAR XCL-USER::AREF1-POINTER XCL-USER::AREF1-XPOINTER XCL-USER::AREF1-PUNT) (* |;;| "array-read and array-write ") (XCL-USER::VERIFIED-TESTS XCL-USER::ARRAY-READ-BIT XCL-USER::ARRAY-READ-BYTE XCL-USER::ARRAY-READ-WORD XCL-USER::ARRAY-READ-SIGNED-WORD XCL-USER::ARRAY-READ-FIXP XCL-USER::ARRAY-READ-FLOATP XCL-USER::ARRAY-READ-THIN-CHAR XCL-USER::ARRAY-READ-FAT-CHAR XCL-USER::ARRAY-READ-POINTER XCL-USER::ARRAY-READ-XPOINTER) (XCL-USER::VERIFIED-TESTS XCL-USER::ARRAY-WRITE-BIT XCL-USER::ARRAY-WRITE-BYTE XCL-USER::ARRAY-WRITE-WORD XCL-USER::ARRAY-WRITE-SIGNED-WORD XCL-USER::ARRAY-WRITE-FIXP XCL-USER::ARRAY-WRITE-FLOATP XCL-USER::ARRAY-WRITE-THIN-CHAR XCL-USER::ARRAY-WRITE-FAT-CHAR XCL-USER::ARRAY-WRITE-POINTER XCL-USER::ARRAY-WRITE-XPOINTER)) (COMS (* |;;| "Boxed opcodes") (XCL-USER::VERIFIED-TESTS XCL-USER::INT+ XCL-USER::FLOAT+ XCL-USER::MIXED+) (TESTS ERROR+) (XCL-USER::VERIFIED-TESTS XCL-USER::INT- XCL-USER::FLOAT- XCL-USER::MIXED-) (XCL-USER::VERIFIED-TESTS XCL-USER::INT* XCL-USER::FLOAT* XCL-USER::MIXED*) (XCL-USER::VERIFIED-TESTS XCL-USER::INT/ XCL-USER::FLOAT/ XCL-USER::MIXED/) (TESTS ERROR/T ERROR/0 NO-ERROR-0/0 ERROR-T/X) (XCL-USER::VERIFIED-TESTS XCL-USER::INT> XCL-USER::FLOAT> XCL-USER::MIXED>)) (COMS (* |;;| "Unboxed opcodes [scalar]") (* |;;| "Ubfloat1") (XCL-USER::VERIFIED-TESTS XCL-USER::BOX XCL-USER::UNBOX XCL-USER::UBABS XCL-USER::UBNEGATE XCL-USER::UBFIX) (* |;;| "Ubfloat2") (XCL-USER::VERIFIED-TESTS XCL-USER::UB+ XCL-USER::UB- XCL-USER::UB* XCL-USER::UB/ XCL-USER::UB> XCL-USER::UBMAX XCL-USER::UBMIN) (* |;;| "Ubfloat3") (XCL-USER::VERIFIED-TESTS XCL-USER::POLY)) (COMS (* |;;| "Transcendentals --- stress test") (XCL-USER::VERIFIED-TESTS XCL-USER::SIN-TEST XCL-USER::COS-TEST XCL-USER::EXP-TEST XCL-USER::LOG-TEST)) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA DORESTLISTTEST DOFINDKEYTEST))))
-)
-
-
-
-(* |;;| "This file contains tests for the various opcodes used in the system.")

-
-
-(RPAQ *TEST-FILE-NAME*
 "OPCODES")
-
-(ADDTOVAR DIRECTORIES
 {ERIS}<TEST>MAIKO>AUX>)
-
-(FILESLOAD OPTESTS BBTESTS)
-
-
-
-(* \; "BITBLT")

-
-
-(DEFTEST (BITBLT-DIAGONALS :COMPILED) (FOR WIDTH IN (QUOTE (1 2 3 4 5 7 8 9 15 16 17 31 32 33 39 40 41)) ALWAYS (PRINT WIDTH) (* \; "DD") (DIAGONALS WIDTH)))
-
-(DEFTEST (BITBLT-SLOPED-LINES :COMPILED) (FOR I IN (QUOTE (1 3 4 5 7 8 9 15 16 17)) DO (SLOPED-LINES I)) T)
-
-
-
-(* \; "COPY.N")

-
-
-(DEFTEST (COPY.N :COMPILED) (* |;;| "COPY.N  opcode") (EQ :OK (XCL-USER::COPY.N.TEST)))
-
-(DEFTEST COPY.N-UFN (EQ :OK (XCL-USER::COPY.N.TEST T)))
-
-
-
-(* \; "STORE.N")

-
-
-(DEFTEST (STORE.N :COMPILED) (* |;;| "COPY.N  opcode") (EQUAL (QUOTE (5 4 T 2 1)) (XCL-USER::STORE.N.TEST)))
-
-(DEFTEST STORE.N-UFN (* |;;| "STORE.N  opcode") (EQUAL (QUOTE (5 4 T 2 1)) (XCL-USER::STORE.N.TEST T)))
-
-
-
-(* \; "POP.N")

-
-
-(DEFTEST (POP.N :COMPILED) (= 3 (XCL-USER::POP.N.TEST)))
-
-(DEFTEST POP.N-UFN (= 3 (XCL-USER::POP.N.TEST T)))
-
-
-
-(* \; "UNWIND")

-
-
-(DEFTEST UNWIND-OFF-BY-1-A (LET ((F CL:PI)) (EQUAL (LIST (QUOTE SUCCESS) (PROGN (|for| C |in| (UNPACK F) |do| (PRIN1 C)) F)) (QUOTE (SUCCESS 3.1415927)))))
-
-(DEFTEST UNWIND-OFF-BY-1-B (* |;;| "Make sure that UNWIND doesn't mung the binding for F during the for loop.") (LET ((F CL:PI)) (|for| C |in| (UNPACK F) |do| (PRIN1 C)) (AND (FLOATP F) (= F CL:PI))))
-(DEFINEQ
-
-(UNWINDTESTER

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 26-Sep-88 14:11 by bvm")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH)
-       |do|
 (LET ((VALUE (UNWINDMAINTEST
 D (LOGAND D 7))))
-                     (COND
-                        ((NEQ VALUE 'SUCCESS)
-                         (HELP "UNWINDMAINTEST did not return correctly" VALUE)))))
-    T))
-
-(UNWINDMAINTEST

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:10 by bvm")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET ((*B* 3)
-              (*C* 2)
-              (*D* DEPTH))
-             (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-             (LIST (UNWINDCHECK1
 DEPTH)
-                   (LET ((*E* 10)
-                         (*F* 11)
-                         (*G* 12)
-                         (*H* DEPTH))
-                        (DECLARE
 (CL:SPECIAL *E* *F* *G* *H*))
-
-                        (* |;;| "There are 8 pvar slots in this frame (for 7 pvars), so empty stack = 8+2 = 10.  Right now the stack depth is up to 13, because of two bind marks and the value returned from UNWINDCHECK1.")

-
-                        (UNWINDCHECKFAIL T *B* *C* *D* *E* *F* 'PREVPREV 'PREVIOUS-VALUE
-                               (PROGN                        (* \; 
-
                            "Unwind stack to depth 10 + {0,1,3,6} preserving tos when code is even")

-                                      (SELECTQ CODE
-                                          (0                 (* \; "Blow away whole stack")

-                                             ((OPCODES UNWIND 10 0)))
-                                          (1                 (* \; "Same as 0 but keep tos")

-                                             ((OPCODES UNWIND 10 1)))
-                                          (2                 (* \; "Blow away second binding only")

-                                             ((OPCODES UNWIND 11 0)))
-                                          (3                 (* \; "Same as 2 but keep tos")

-                                             ((OPCODES UNWIND 11 1)))
-                                          (4                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 13 0)))
-                                          (5                 (* \; "Same as 4 but keep tos")

-                                             ((OPCODES UNWIND 13 1)))
-                                          (6                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 16 0)))
-                                          ((OPCODES UNWIND 16 1))))
-                               (PROGN                        (* \; 
-
                                     "Check that previous opcode left the stack in the right state")

-                                      (UNWINDCHECK2
 CODE)))))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UNWINDMAINTEST.RECURSE
 (SUB1 DEPTH)
-                 CODE)))))
-
-(UNWINDMAINTEST.RECURSE

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:08 by bvm")

-    (UNWINDMAINTEST
 DEPTH CODE)))
-
-(UNWINDCHECK1

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 13:15")

-                                                             (* \; 
-
                                                "This just prevents compiler from merging specials")

-    NIL))
-
-(UNWINDCHECK2

-  (LAMBDA (CODE)
                                         (* \; "Edited 26-Sep-88 14:10 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.  TOS should be PREVIOUS-VALUE if the UNWIND said to preserve TOS.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD (+ 10 (LOGAND CODE 1)
-                                  (SELECTQ (LRSH CODE 1)
-                                      (0 0)
-                                      (1 1)
-                                      (2 3)
-                                      6))
-                              WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT (UNWINDCODE
 CODE)
-                           " unwound stack "
-                           (COND
-                              ((GREATERP GOODEOS EOS)
-                               "too far")
-                              (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words")))
-             ((AND (ODDP CODE)
-                   (NEQ (\\GETBASEPTR (ADDSTACKBASE (IDIFFERENCE EOS WORDSPERCELL))
-                               0)
-                        'PREVIOUS-VALUE))                    (* \; "Should have preserved tos")

-              (HELP (UNWINDCODE
 CODE)
-                    " did not preserve top of stack")))
-          (|for|
 V |in|
 '(*B* *C* *D* *E* *F* *G* *H*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (SELECTQ (LRSH CODE 1)
-                                                 (0 T)
-                                                 (1 (FMEMB V '(*E* *F* *G* *H*)))
-                                                 NIL))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT (UNWINDCODE
 CODE)
-                                                         " left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT (UNWINDCODE
 CODE)
-                                    " left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from UNWINDMAINTEST because the UNWIND there has ruined its stack")

-
-                 (RETFROM 'UNWINDMAINTEST 'SUCCESS)))))
-
-(UNWINDCODE

-  (LAMBDA (CODE)
                                         (* |bvm:| "21-Jul-86 15:34")

-    (CONCAT "UNWIND." (PLUS 10 (LOGAND CODE 1))
-           "."
-           (LRSH CODE 1))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD BINDMARKSLOT
 ((BINDMARKP FLAG) (NIL BITS 15)) (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD) (BINDLASTPVAR WORD)))
- (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN (* |Value| |stored| |in| |high| |half| |is| |one's| |complement| |of| |number| |of| |values| |bound|) (LOGXOR (|fetch| BINDNEGVALUES |of| DATUM) 65535)))))
-)
-)
-)
-(DEFINEQ
-
-(UW2.TEST

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 15:00 by vanmelle")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (UW2.TEST.MAIN
))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UW2.RECURSE
 (SUB1 DEPTH))))))
-
-(UW2.RECURSE

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 14:56 by vanmelle")

-                                                             (* \; "To foil compiler")

-    (UW2.TEST
 DEPTH)))
-
-(UW2.TEST.MAIN

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 20-Oct-88 15:49 by bvm")

-    (LET ((*B* 3)
-          (*C* 2.4)
-          (*D* DEPTH))
-         (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-         (LIST (UW2.IDENTITY
 'TOS)
-               (LET ((*E* 3.5))
-                    (DECLARE
 (CL:SPECIAL *E*))
-
-                    (* |;;| "There are 4 pvar slots in this frame, so empty stack = 4+2 = 6.  Right now the stack depth is up to 9, because of 2 bind marks and the value from NILL.")

-
-                    (UNWINDCHECKFAIL T NIL ((OPCODES UNWIND 9 0))
-                           (UW2.CHECK
)))))))
-
-(UW2.CHECK

-  (LAMBDA NIL
                                            (* \; "Edited 20-Oct-88 15:49 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD 9 WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT "Unwound stack " (COND
-                                                ((GREATERP GOODEOS EOS)
-                                                 "too far")
-                                                (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words"))))
-          (|for|
 V |in|
 '(*B* *C* *D* *E*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (AND NIL (EQ V '*E*)))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT "UNWIND left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT "UNWIND left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from test because the UNWIND there has confused its stack")

-
-                 (RETFROM 'UW2.TEST.MAIN 'SUCCESS)))))
-
-(UW2.IDENTITY

-  (LAMBDA (X)
                                            (* \; "Edited 20-Oct-88 15:19 by bvm")

-                                                             (* \; 
-
                                                           "Identity compiler doesn't know about")

-    X))
-)
-
-(DEFTEST (UNWIND :COMPILED) (UNWINDTESTER))
-
-(DEFTEST (UNWIND-2 :COMPILED) (FOR I FROM 0 TO 100 ALWAYS (EQ (QUOTE SUCCESS) (UW2.TEST I))))
-
-
-
-(* \; "FINDKEY")

-
-(DEFINEQ
-
-(FINDKEYTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "14-Jul-86 17:54")

-
-(* |;;;| "Test the opcode FINDKEY")

-
-    (DOFINDKEYTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)))
-
-(DOFINDKEYTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (FINDKEYCHECK 1 ||)
-         (FINDKEYCHECK 2 ||)
-         (FINDKEYCHECK 3 ||)
-         (FINDKEYCHECK 4 ||)
-         (FINDKEYCHECK 5 ||)
-         (FINDKEYCHECK 6 ||)
-         (FINDKEYCHECK 7 ||)
-         (FINDKEYCHECK 8 ||)
-         (FINDKEYCHECK 1 KEYB)
-         (FINDKEYCHECK 2 KEYB)
-         (FINDKEYCHECK 3 KEYB)
-         (FINDKEYCHECK 4 KEYB)
-         (FINDKEYCHECK 5 KEYB)
-         (FINDKEYCHECK 6 KEYB)
-         (FINDKEYCHECK 7 KEYB)
-         (FINDKEYCHECK 8 KEYB)
-         (FINDKEYCHECK 1 KEYC)
-         (FINDKEYCHECK 2 KEYC)
-         (FINDKEYCHECK 3 KEYC)
-         (FINDKEYCHECK 4 KEYC)
-         (FINDKEYCHECK 5 KEYC)
-         (FINDKEYCHECK 6 KEYC)
-         (FINDKEYCHECK 7 KEYC)
-         (FINDKEYCHECK 8 KEYC))))
-
-(DOFINDKEYTEST1

-  (LAMBDA (RESULT N KEY)
                                 (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (LET ((ANSWER (|for|
 I |from|
 N |by|
 2 |to|
 KEYARGS
-                     |when|
 (EQ KEY (ARG KEYARGS I)) |do|
 (RETURN (ADD1 I)))))
-         (COND
-            ((NEQ ANSWER RESULT)
-             (HELP (CONCAT "FINDKEY." N " returned " RESULT " instead of " ANSWER " for ")
-                   KEY))
-            (T T)))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS FINDKEYCHECK DMACRO (DEFMACRO (N KEY) (BQUOTE (DOFINDKEYTEST1 ((OPCODES FINDKEY (\\\, N)) (QUOTE (\\\, KEY))) (\\\, N) (QUOTE (\\\, KEY))))))
-)
-)
-
-(DEFTEST (FINDKEY :COMPILED) (FINDKEYTESTER))
-
-
-
-(* \; "RESTLIST")

-
-(DEFINEQ
-
-(\\RESTLIST.SPLICE.FRAME

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:13")

-
-(* |;;;| "If caller is fast, so its BF is contiguous with its caller's FX, then adjust pointers so that its first ivar goes back on it's caller's fx, and back up pc")

-
-    (UNINTERRUPTABLY
-        (LET ((CALLER (\\MYALINK))
-              CALLER2 IVAR BF)
-             (COND
-                ((AND (|fetch|
 (FX FASTP) |of|
 CALLER)
-                      (EQ (SETQ IVAR (|fetch|
 (BF IVAR) |of|
 (SETQ BF (|fetch|

-                                                                               (FX DUMMYBF)
-                                                                                 |of|
 CALLER))))
-                          (|fetch|
 (FX NEXTBLOCK) |of|
 (SETQ CALLER2 (|fetch|

-                                                                              (FX ALINK) |of|

-                                                                                         CALLER)))))
-                 (|replace|
 (BF IVAR) |of|
 BF |with|
 (|add|
 IVAR WORDSPERCELL))
-                 (|replace|
 (FX NEXTBLOCK) |of|
 CALLER2 |with|
 IVAR)
-                 (|add|
 (|fetch|
 (FX PC) |of|
 CALLER2)
-                        -2)
-                 T))))))
-
-(RESTLISTTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:28")

-
-(* |;;;| "Test the opcode RESTLIST")

-
-    (AND (DORESTLISTTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)
-         (DORESTLISTTEST
 '(||)
-                '(VALA)
-                '(KEYB)
-                'VALB
-                '(KEYC)
-                '(VALC))
-         (DORESTLISTTEST
)
-         (\\COMPUTED.FORM (CONS 'DORESTLISTTEST (|for|
 I |from|
 1 |to|
 200
-                                                   |collect|
 `',(LIST I)))))))
-
-(DORESTLISTTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:39")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (RESTLISTCHECK 1)
-         (RESTLISTCHECK 2)
-         (RESTLISTCHECK 3)
-         (RESTLISTCHECK 4)
-         (RESTLISTCHECK 5)
-         (RESTLISTCHECK 6)
-         (RESTLISTCHECK 7)
-         (RESTLISTCHECK 8))))
-
-(GETRESTARGREFCNTS

-  (LAMBDA (N)
-    (DECLARE
 (USEDFREE KEYARGS))
                     (* |bvm:| "18-Jul-86 15:01")

-    (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (\\REFCNT (ARG KEYARGS I)))))
-
-(DORESTLISTTEST1

-  (LAMBDA (REFCNTS RESULT N)
                             (* |bvm:| "21-Jul-86 17:22")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (COND
-       ((OR (NOT (EQLENGTH RESULT (IMAX (IDIFFERENCE KEYARGS (SUB1 N))
-                                        0)))
-            (|for|
 R |in|
 RESULT |as|
 I |from|
 N |to|
 KEYARGS
-               |thereis|
 (NEQ R (ARG KEYARGS I))))
-        (HELP (CONCAT "RESTLIST." N " returned " RESULT " instead of "
-                     (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (ARG KEYARGS I))))))
-    (|for|
 TAIL |on|
 RESULT |as|
 CNT |in|
 REFCNTS |as|
 I |from|
 1
-       |do|
 (COND
-                   ((AND (NEQ (\\REFCNT (CAR TAIL))
-                              (ADD1 CNT))
-                         (NOT (|fetch|
 (MDSTYPEWORD NOREFCNT)
-                                 |of|
 (\\ADDBASE |\\MDSTypeTable| (LRSH (|fetch|
 (POINTER
-                                                                                          PAGE#)
-                                                                               |of|
 (CAR TAIL))
-                                                                            1)))))
-                    (HELP (CONCAT "Ref cnt of " I "th RESTLIST element was not incremented")
-                          (CONCAT "Was " CNT ", now is " (\\REFCNT (CAR TAIL)))))
-                   ((NEQ (\\REFCNT TAIL)
-                         (COND
-                            ((EQ TAIL RESULT)
-                             0)
-                            (T 1)))
-                    (HELP (COND
-                             ((EQ TAIL RESULT)
-                              "Ref cnt of RESTLIST value is not zero")
-                             (T "Ref cnt of RESTLIST tail is not one"))
-                          (\\REFCNT TAIL)))))
-    T))
-)
-
-(RPAQ? RESTLISTCOUNTER
 0)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS RESTLISTCHECK DMACRO (DEFMACRO (N) (BQUOTE (PROGN (RECLAIM) (DORESTLISTTEST1 (GETRESTARGREFCNTS (\\\, N)) ((OPCODES RESTLIST (\\\, N)) NIL KEYARGS) (\\\, N))))))
-
-(PUTPROPS \\COMPUTED.FORM MACRO (X (CONS (QUOTE PROGN) (MAPCAR X (FUNCTION EVAL)))))
-)
-
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD MDSTYPEWORD
 ((NOREFCNT FLAG) (NIL BITS 15)))
-)
-
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS RESTLISTCOUNTER)
-)
-)
-
-(DEFTEST (RESTLIST :COMPILED) (RESTLISTTESTER))
-
-
-
-(* \; "Closure tests")

-
-(DEFINEQ
-
-(CLOSURETESTER

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH) |always|
 (CLOSUREMAINTEST

-                                                                                  D))))
-
-(CLOSUREMAINTEST

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET (VALUE)
-             (PUTD 'CLOSUREFN4 (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM DEFPOINTER)
-                                                         |of|
 'CLOSUREFN4CODE)
-                                      CLOSURETEST.ENVIRONMENT))
-             (COND
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (GETD 'CLOSUREFN1)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN1VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN1 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM 
-                                                                                           DEFPOINTER
-                                                                                             )
-                                                                            |of|
 'CLOSUREFN2)
-                                                         CLOSURETEST.ENVIRONMENT)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN2VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN2 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (CLOSUREFN4))
-                             (CLOSUREFN4VALUE
)))
-                 (HELP "CLOSUREFN4 returned the wrong value" VALUE))
-                (T T))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (CLOSUREMAINTEST.RECURSE
 (SUB1 DEPTH))))))
-
-(CLOSUREMAINTEST.RECURSE

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "18-Jul-86 14:07")

-    (CLOSUREMAINTEST
 DEPTH)))
-
-(CLOSUREFNCHECK

-  (LAMBDA (CLOSUREP FUNCALLP)
                            (* |bvm:| "18-Jul-86 14:48")

-    (LET* ((CALLER (\\MYALINK))
-           (PVAR0 (STACKADDBASE (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER))))
-          (COND
-             (CLOSUREP (COND
-                          ((NEQ (\\GETBASEPTR PVAR0 0)
-                                CLOSURETEST.ENVIRONMENT)
-                           (HELP (COND
-                                    (FUNCALLP "FUNCALL of a full closure")
-                                    (T "Call to symbol with Closure definition"))
-                                 " did not store closure environment in pvar0"))))
-             ((|fetch|
 (PVARSLOT BOUND) |of|
 PVAR0)
-              (HELP "FUNCALL of a null closure stored something into pvar0"))))))
-
-(CLOSUREFNCHECK2

-  (LAMBDA NIL
                                            (* |bvm:| "18-Jul-86 14:51")

-                                                             (* \; 
-
                                                           "Nothing really to check for now")

-    NIL))
-
-(CLOSUREFN1

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN1VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN1VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-    (LIST ARG1 ARG2 ARG3 ARG4)))
-
-(CLOSUREFN2

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 T T)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN2VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN2VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-    (LIST ARG4 ARG3 ARG2 ARG1)))
-
-(CLOSUREFN4CODE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:53")

-                                                             (* \; "closure called via FNx")

-    (CLOSUREFNCHECK
 T NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN4VALUE
 ARG1 ARG2 ARG3))))
-
-(CLOSUREFN4VALUE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:38")

-    (LIST ARG2 ARG3 ARG1)))
-)
-
-(RPAQ? CLOSURETEST.DEPTH
 50)
-
-(RPAQ? CLOSURETEST.ENVIRONMENT
 "Closure Environment")
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT)
-)
-
-(DEFTEST (CLOSURES :COMPILED) (CLOSURETESTER))
-
-
-
-(* \; "Free-variable lookup")

-
-(DEFINEQ
-
-(FVARTEST0

-(LAMBDA NIL (* \; "Edited  2-Aug-88 23:04 by FS") (SETTOPVAL (QUOTE TOPLEVEL1) 1) (SETTOPVAL (QUOTE TOPLEVEL2) 2) (SETTOPVAL (QUOTE NITERS) 3) (EQ (ITIMES NITERS 334) (FVARTEST1 100 200 4)))
-)
-
-(FVARTEST1

-(LAMBDA (IVAR1 IVAR2 DEPTH) (* \; "Edited  2-Aug-88 23:02 by FS") (* |;;| "Recurse DEPTH times and then call FVARTEST2 to test free variable lookup.") (LET (PVAR1) (* |;;| "This block is here so that name table scanning will find it, but must skip it.  PRINT so the compiler won't throw the block away.") (SETQ PVAR1 DEPTH) (PRINTOUT T "AT DEPTH " PVAR1 T)) (LET (PVAR1 PVAR2) (SETQ PVAR1 10) (SETQ PVAR2 20) (COND ((<= DEPTH 0) (FVARTEST2 4)) (T (FVARTEST1 IVAR1 IVAR2 (SUB1 DEPTH))))))
-)
-
-(FVARTEST2

-(LAMBDA (DEPTH) (* \; "Edited  2-Aug-88 22:56 by FS") (* |;;| "Recurse DEPTH times and then freely reference IVars, PVars, Globals.") (* |;;| "") (* |;;| "It needs to search past its own frames (the vars are unbound), and past FVARTEST1's frames for the globals.") (* |;;| "") (* |;;| "It will  find IVARx, PVARx in FVARTEST1's frames.") (* |;;| "") (* |;;| " Loop based on the freely referenced NITERS, to test FVAR  caching.") (PROG (NAMETBLE1 NAMETBLE2 TOTAL) (COND ((<= DEPTH 0) (SETQ TOTAL 0) (|for| I |from| 1 |to| NITERS |do| (SETQ TOTAL (+ TOTAL IVAR1 IVAR2 PVAR1 PVAR2 TOPLEVEL1 TOPLEVEL2 (FVARTEST3)))) (RETURN TOTAL)) (T (RETURN (FVARTEST2 (SUB1 DEPTH)))))))
-)
-
-(FVARTEST3

-(LAMBDA NIL (* \; "Edited  2-Aug-88 22:54 by FS") (* |;;| "Should find TOPLEVEL1 in FVARTEST2's frame (no way to test if this is really happening, but it should test a branch of the C code.") TOPLEVEL1)
-)
-)
-
-(DEFTEST FREE-VAR-LOOKUP (FVARTEST0))
-
-
-
-(* \; "AREF opcode tests")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-BIT "Opcode aref1, type (unsigned-byte 1)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 1)) :INITIAL-CONTENTS (QUOTE (0 1 0 1)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 1)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-BYTE "Opcode aref1, type (unsigned-byte 8)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :INITIAL-CONTENTS (QUOTE (0 34 56 255 23)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-WORD "Opcode aref1, type (unsigned-byte 16)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 16)) :INITIAL-CONTENTS (QUOTE (0 34 255 65535 23)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 16)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-SIGNED-WORD "Opcode aref1, type (signed-byte 16)" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:SIGNED-BYTE 16)) :INITIAL-CONTENTS (QUOTE (0 -34 255 -32768 23))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-FIXP "Opcode aref1, type (signed-byte 32)" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:SIGNED-BYTE 32)) :INITIAL-CONTENTS (QUOTE (0 -34 258 -65538 2147483647))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-FLOATP "Opcode aref1, type single-float" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE CL:SINGLE-FLOAT) :INITIAL-CONTENTS (QUOTE (0.0 -34.0 3.456756E+35 -5.768E-34 5.4524))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-STRING-CHAR "Opcode aref1, type string-char" (LET ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 3 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :INITIAL-CONTENTS (QUOTE (#\Space #\a #\b)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 3 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :FATP T :INITIAL-CONTENTS (QUOTE (#\Space #\Greek-0 #\Greek-32))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 3) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-POINTER "Opcode aref1, type t" (LET* ((XCL-USER::LST (LIST 0 (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B)) 3.4 (QUOTE XCL-USER::C) (CONS (QUOTE XCL-USER::D) (QUOTE XCL-USER::E)))) (CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE T :INITIAL-CONTENTS XCL-USER::LST))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CONS (CL:AREF CL:ARRAY XCL-USER::I) (\\REFCNT (CL:AREF CL:ARRAY XCL-USER::I))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-XPOINTER "Opcode aref1, type il:xpointer" (LET* ((XCL-USER::LST (LIST 0 (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B)) 3.4 (QUOTE XCL-USER::C) (CONS (QUOTE XCL-USER::D) (QUOTE XCL-USER::E)))) (CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE XPOINTER) :INITIAL-CONTENTS XCL-USER::LST))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CONS (CL:AREF CL:ARRAY XCL-USER::I) (\\REFCNT (CL:AREF CL:ARRAY XCL-USER::I))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-PUNT "Opcode aref1, punt cases" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :DISPLACED-TO (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :INITIAL-CONTENTS (QUOTE (#\a #\b #\c #\d))))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE T :ADJUSTABLE T :INITIAL-CONTENTS (QUOTE (0 XCL-USER::A XCL-USER::B (XCL-USER::A . XCL-USER::B))))) (XCL-USER::ARRAY-3 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :READ-ONLY-P T :INITIAL-CONTENTS (QUOTE (0 1 2 3))))) (* |;;| "aref1 should punt on all these cases") (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-3 XCL-USER::I))))))
-
-
-
-(* |;;| "array-read and array-write ")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-BIT "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 1)" (CL:FLET ((XCL-USER::ARRAY-READ-BIT (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 0 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 8 0))) (\\PUTBASEBYTE XCL-USER::BASE 0 160) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-BIT XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-BYTE "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 8)" (CL:FLET ((XCL-USER::ARRAY-READ-BYTE (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 3 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 3))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 4)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEBYTE XCL-USER::BASE XCL-USER::I (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-BYTE XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-WORD "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 16)" (CL:FLET ((XCL-USER::ARRAY-READ-WORD (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 4 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 4))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 65535)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-WORD XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-SIGNED-WORD "Opcode ARRAYREAD (MISC3 9), type (signed-byte 16)" (CL:FLET ((XCL-USER::ARRAY-READ-SIGNED-WORD (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 20 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 20))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 255 -32768)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (\\LOLOC (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-SIGNED-WORD XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FIXP "Opcode ARRAYREAD (MISC3 9), type (signed-byte 32)" (CL:FLET ((XCL-USER::ARRAY-READ-FIXP (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 22 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 22))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 65536 -2147483648)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEFIXP XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FIXP XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FLOATP "Opcode ARRAYREAD (MISC3 9), type single-float" (CL:FLET ((XCL-USER::ARRAY-READ-FLOATP (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 54 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 54))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0.0 -23.0 3.4456E+24 -4.562435E-12)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEFLOATP XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FLOATP XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-THIN-CHAR "Opcode ARRAYREAD (MISC3 9), type string-char" (CL:FLET ((XCL-USER::ARRAY-READ-THIN-CHAR (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 67 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 67))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEBYTE XCL-USER::BASE XCL-USER::I (CL:CHAR-CODE (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-THIN-CHAR XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FAT-CHAR "Opcode ARRAYREAD (MISC3 9), type fat-string-char" (CL:FLET ((XCL-USER::ARRAY-READ-FAT-CHAR (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 68 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 68))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (CL:CHAR-CODE (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FAT-CHAR XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-POINTER "Opcode ARRAYREAD (MISC3 9), type t" (CL:FLET ((XCL-USER::ARRAY-READ-POINTER (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 38 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 38))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (2 #\c 2.3 (XCL-USER::A . XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\RPLPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-POINTER XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-XPOINTER "Opcode ARRAYREAD (MISC3 9), type il:xpointer" (CL:FLET ((XCL-USER::ARRAY-READ-XPOINTER (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 86 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 86))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (2 #\c 2.3 (XCL-USER::A . XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-XPOINTER XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-BIT "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 1)" (CL:FLET ((XCL-USER::ARRAY-WRITE-BIT (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 0 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 8 0))) (\\PUTBASEBYTE XCL-USER::BASE 0 160) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (1 0 1 0)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-BIT (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (LET ((BYTE (\\GETBASEBYTE XCL-USER::BASE 0))) (LIST (LDB (BYTE 1 7) BYTE) (LDB (BYTE 1 6) BYTE) (LDB (BYTE 1 5) BYTE) (LDB (BYTE 1 4) BYTE))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-BYTE "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 8)" (CL:FLET ((XCL-USER::ARRAY-WRITE-BYTE (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 3 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 3))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 4)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-BYTE (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEBYTE XCL-USER::BASE XCL-USER::I)))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-WORD "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 16)" (CL:FLET ((XCL-USER::ARRAY-WRITE-WORD (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 4 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 4))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 65535)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-WORD (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASE XCL-USER::BASE XCL-USER::I)))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-SIGNED-WORD "Opcode ARRAYWRITE (MISC4 7), type (signed-byte 16)" (CL:FLET ((XCL-USER::ARRAY-WRITE-SIGNED-WORD (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 20 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 20))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 255 -32768)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-SIGNED-WORD (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (LET ((XCL-USER::WORD (\\GETBASE XCL-USER::BASE XCL-USER::I))) (CL:IF (> XCL-USER::WORD 32767) (\\VAG2 15 XCL-USER::WORD) XCL-USER::WORD))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FIXP "Opcode ARRAYWRITE (MISC4 7), type (signed-byte 32)" (CL:FLET ((XCL-USER::ARRAY-WRITE-FIXP (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 22 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 22))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 65536 -2147483648)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FIXP (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEFIXP XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FLOATP "Opcode ARRAYWRITE (MISC4 7), type single-float" (CL:FLET ((XCL-USER::ARRAY-WRITE-FLOATP (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 54 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 54))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0.0 -23.0 3.4456E+24 -4.562435E-12)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FLOATP (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEFLOATP XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-THIN-CHAR "Opcode ARRAYWRITE (MISC4 7), type thin-string-char" (CL:FLET ((XCL-USER::ARRAY-WRITE-THIN-CHAR (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 67 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 67))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-THIN-CHAR (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:CODE-CHAR (\\GETBASEBYTE XCL-USER::BASE XCL-USER::I))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FAT-CHAR "Opcode ARRAYWRITE (MISC4 7), type fat-string-char" (CL:FLET ((XCL-USER::ARRAY-WRITE-FAT-CHAR (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 68 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 68))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FAT-CHAR (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:CODE-CHAR (\\GETBASE XCL-USER::BASE XCL-USER::I))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-POINTER "Opcode ARRAYWRITE (MISC4 7), type t" (CL:FLET ((XCL-USER::ARRAY-WRITE-POINTER (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 38 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 38))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (LIST 2 #\c (QUOTE XCL-USER::A) (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-POINTER (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CONS (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1)) (\\REFCNT (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-XPOINTER "Opcode ARRAYWRITE (MISC4 7), type il:xpointer" (CL:FLET ((XCL-USER::ARRAY-WRITE-XPOINTER (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 86 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 86))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (LIST 2 #\c (QUOTE XCL-USER::A) (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-XPOINTER (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CONS (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1)) (\\REFCNT (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))))
-
-
-
-(* |;;| "Boxed opcodes")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT+ "Opcodes IPLUS,FPLUS, and PLUS, both args integer" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1 -3 9834756987354 21845 -54))) (CL:DOLIST (XCL-USER::Y (QUOTE (1 -3 9834756987354 21845 -54))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT+ "Opcodes IPLUS,FPLUS, and PLUS, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 -3.0 -3.4028235E+38 21845.0 -54.0))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED+ "Opcodes IPLUS,FPLUS, and PLUS, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 -3 1/3 9834756987354 21845 -54))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(DEFTEST ERROR+ (EXPECT-ERRORS (T) (+ T 3)))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 3 9834756987354 21845 -54))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 3.0 3.4028235E+38 21845.0 -54.0))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 3 1/3 9834756987354 21845 -54))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT* "Opcodes ITIMES,FTIMES, and TIMES, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45 345235424 0 23 21845))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT* "Opcodes ITIMES,FTIMES, and TIMES, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45.0 0.0 1.1342745E+38 -21845.0))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED* "Opcodes ITIMES,FTIMES, and TIMES, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45 1/3 345235424 0 23 21845))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args integer" (LET ((XCL-USER::X 21845)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1 345235424 -45))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args float" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, args mixed" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1 4/3 -1345619432 45))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(DEFTEST ERROR/T (EXPECT-ERRORS (T) (/ 34 T)))
-
-(DEFTEST ERROR/0 (EXPECT-ERRORS (T) (/ 34 0)))
-
-(DEFTEST NO-ERROR-0/0 (/ 0 0))
-
-(DEFTEST ERROR-T/X (EXPECT-ERRORS (T) (/ T 5)))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 -45 345235424 22000))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 22000.0))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1/3 -45 5498457654 22000))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-
-
-(* |;;| "Unboxed opcodes [scalar]")

-
-
-
-
-(* |;;| "Ubfloat1")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::BOX "Opcode BOX (UBFLOAT1 0)" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE ((16256 . 0) (0 . 0) (49716 . 0) (26309 . 45156)))) (XCL:COLLECT (\\FLOATBOX (\\VAG2 (CAR XCL-USER::X) (CDR XCL-USER::X)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UNBOX "Opcode UNBOX (UBFLOAT1 1)" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1.0 0.0 -45.0 4.6678E+23))) (LET ((XCL-USER::Y (\\FLOATUNBOX XCL-USER::X))) (XCL:COLLECT (CONS (\\HILOC XCL-USER::Y) (\\LOLOC XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBABS "Opcode UFABS (UBFLOAT1 2)" (CL:FLET ((XCL-USER::UBABS (XCL-USER::X) (\\FLOATBOX ((OPCODES UBFLOAT1 2) (\\FLOATUNBOX XCL-USER::X))))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBABS XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBNEGATE "Opcode UFNEGATE (UBFLOAT1 3)" (CL:FLET ((XCL-USER::UBNEGATE (XCL-USER::X) (\\FLOATBOX ((OPCODES UBFLOAT1 3) (\\FLOATUNBOX XCL-USER::X))))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBNEGATE XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBFIX "Opcode UFIX (UBFLOAT1 4)" (CL:FLET ((XCL-USER::UBFIX (XCL-USER::X) ((OPCODES UBFLOAT1 4) (\\FLOATUNBOX XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBFIX XCL-USER::X))))))
-
-
-
-(* |;;| "Ubfloat2")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB+ "Opcode UFADD (UBFLOAT2 0)" (CL:FLET ((XCL-USER::UB+ (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 0) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 -3.0 -3.4028235E+38 21845.0 3))) (XCL:COLLECT (XCL-USER::UB+ XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB- "Opcode UFSUB (UBFLOAT2 1)" (CL:FLET ((XCL-USER::UB- (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((* |;;| "ub -") (OPCODES UBFLOAT2 1) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 3.0 3.4028235E+38 21845 1/3 -54.0))) (XCL:COLLECT (XCL-USER::UB- XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB* "Opcode UFMULT (UBFLOAT2 3)" (CL:FLET ((XCL-USER::UB* (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 3) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45.0 0.0 1.1342745E+38 -21845.0))) (XCL:COLLECT (XCL-USER::UB* XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB/ "Opcode UFDIV (UBFLOAT2 4)" (CL:FLET ((XCL-USER::UB/ (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 4) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (0.001 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (XCL:COLLECT (XCL-USER::UB/ XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB> "Opcode UFGREAT (UBFLOAT2 5)" (CL:FLET ((XCL-USER::UB> (XCL-USER::X XCL-USER::Y) ((OPCODES UBFLOAT2 5) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y)))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UB> XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBMAX "Opcode UFMAX (UBFLOAT2 6)" (CL:FLET ((XCL-USER::UBMAX (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 6) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UBMAX XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBMIN "Opcode UFMAX (UBFLOAT2 7)" (CL:FLET ((XCL-USER::UBMIN (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 7) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UBMIN XCL-USER::X XCL-USER::Y)))))))
-
-
-
-(* |;;| "Ubfloat3")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::POLY "Opcode POLY (UBFLOAT3 0)" (CL:FLET ((XCL-USER::POLY (XCL-USER::X XCL-USER::BASE XCL-USER::SIZE) (\\FLOATBOX ((OPCODES UBFLOAT3 0) (\\FLOATUNBOX XCL-USER::X) XCL-USER::BASE XCL-USER::SIZE)))) (LET* ((CL:ARRAY (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:SINGLE-FLOAT) :INITIAL-CONTENTS (QUOTE (1.0 2.0 3.0 4.0)))) (XCL-USER::BASE (%ARRAY-BASE CL:ARRAY))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::PAIR (QUOTE ((1.0 . 3) (1.0 . 1) (3.5 . 3)))) (XCL:COLLECT (XCL-USER::POLY (CAR XCL-USER::PAIR) XCL-USER::BASE (CDR XCL-USER::PAIR))))))))
-
-
-
-(* |;;| "Transcendentals --- stress test")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::SIN-TEST "Function SIN" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (0.0 1/3 -1.2 12.6))) (XCL:COLLECT (CL:SIN (CL:* CL:PI XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::COS-TEST "Function COS" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (0.0 1/3 -1.2 12.6))) (XCL:COLLECT (CL:COS (CL:* CL:PI XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::EXP-TEST "Function EXP" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1.0 20.5 1/3 -5.2))) (XCL:COLLECT (CL:EXP XCL-USER::X)))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::LOG-TEST "Function LOG" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (2.7182817 -2.0 453.78))) (XCL:COLLECT (CL:LOG XCL-USER::X)))))
-(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
-
-(ADDTOVAR NLAMA
 )
-
-(ADDTOVAR NLAML
 )
-
-(ADDTOVAR LAMA
 DORESTLISTTEST DOFINDKEYTEST)
-)
-(PUTPROPS OPCODES.TEST COPYRIGHT ("ENVOS Corporation" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (5655 12438 (UNWINDTESTER 5665 . 6086) (UNWINDMAINTEST 6088 . 9096) (
-UNWINDMAINTEST.RECURSE 9098 . 9267) (UNWINDCHECK1 9269 . 9567) (UNWINDCHECK2 9569 . 12234) (UNWINDCODE
- 12236 . 12436)) (12839 16098 (UW2.TEST 12849 . 13280) (UW2.RECURSE 13282 . 13521) (UW2.TEST.MAIN 
-13523 . 14180) (UW2.CHECK 14182 . 15790) (UW2.IDENTITY 15792 . 16096)) (16264 17869 (FINDKEYTESTER 
-16274 . 16488) (DOFINDKEYTEST 16490 . 17370) (DOFINDKEYTEST1 17372 . 17867)) (18159 22548 (
-\\RESTLIST.SPLICE.FRAME 18169 . 19503) (RESTLISTTESTER 19505 . 20079) (DORESTLISTTEST 20081 . 20450) (
-GETRESTARGREFCNTS 20452 . 20673) (DORESTLISTTEST1 20675 . 22546)) (23140 28556 (CLOSURETESTER 23150 . 
-23452) (CLOSUREMAINTEST 23454 . 25455) (CLOSUREMAINTEST.RECURSE 25457 . 25613) (CLOSUREFNCHECK 25615
- . 26418) (CLOSUREFNCHECK2 26420 . 26714) (CLOSUREFN1 26716 . 27205) (CLOSUREFN1VALUE 27207 . 27354) (
-CLOSUREFN2 27356 . 27845) (CLOSUREFN2VALUE 27847 . 27994) (CLOSUREFN4CODE 27996 . 28410) (
-CLOSUREFN4VALUE 28412 . 28554)) (28829 30463 (FVARTEST0 28839 . 29046) (FVARTEST1 29048 . 29552) (
-FVARTEST2 29554 . 30240) (FVARTEST3 30242 . 30461)))))
-STOP

internal/test/Maiko/AUTO/OPCODES.TEST.~5~

@@ -1,823 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "16-Nov-88 14:59:09" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;8
 69120  
-
-      |changes| |to:|  (XCL-USER::VERIFIED-TESTS XCL-USER::AREF1-POINTER XCL-USER::AREF1-XPOINTER) (TESTS ERROR+ ERROR/T ERROR/0 NO-ERROR-0/0)
- (FUNCTIONS SIMULATE-PILOTBITBLT BUMP SLOPED-LINES DIAGONALS XCL-USER::COPY.N.TEST XCL-USER::STORE.N.TEST XCL-USER::POP.N.TEST)
- (VARS OPCODESCOMS) (FNS ADDR-IN-RANGE)
-
-      |previous| |date:| " 8-Nov-88 17:10:36" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;7)
-
-
-; Copyright (c) 1988 by ENVOS Corporation.  All rights reserved.
-
-(PRETTYCOMPRINT OPCODESCOMS)
-
-(RPAQQ OPCODESCOMS ((* |;;| "This file contains tests for the various opcodes used in the system.") (VARS (*TEST-FILE-NAME* "OPCODES")) (COMS (* \; "BITBLT") (FUNCTIONS SIMULATE-PILOTBITBLT BUMP) (FUNCTIONS SLOPED-LINES DIAGONALS) (FNS ADDR-IN-RANGE) (TESTS BITBLT-DIAGONALS BITBLT-SLOPED-LINES)) (COMS (* \; "COPY.N") (FUNCTIONS XCL-USER::COPY.N.TEST) (TESTS COPY.N COPY.N-UFN)) (COMS (* \; "STORE.N") (FUNCTIONS XCL-USER::STORE.N.TEST) (TESTS STORE.N STORE.N-UFN)) (COMS (* \; "POP.N") (FUNCTIONS XCL-USER::POP.N.TEST) (TESTS POP.N POP.N-UFN)) (COMS (* \; "UNWIND") (TESTS UNWIND-OFF-BY-1-A UNWIND-OFF-BY-1-B) (FNS UNWINDTESTER UNWINDMAINTEST UNWINDMAINTEST.RECURSE UNWINDCHECK1 UNWINDCHECK2 UNWINDCODE) (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS BINDMARKSLOT)) (FNS UW2.TEST UW2.RECURSE UW2.TEST.MAIN UW2.CHECK UW2.IDENTITY) (TESTS UNWIND UNWIND-2)) (COMS (* \; "FINDKEY") (FNS FINDKEYTESTER DOFINDKEYTEST DOFINDKEYTEST1) (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS FINDKEYCHECK)) (TESTS FINDKEY)) (COMS (* \; "RESTLIST") (FNS \\RESTLIST.SPLICE.FRAME RESTLISTTESTER DORESTLISTTEST GETRESTARGREFCNTS DORESTLISTTEST1) (INITVARS (RESTLISTCOUNTER 0)) (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS RESTLISTCHECK \\COMPUTED.FORM) (RECORDS MDSTYPEWORD) (GLOBALVARS RESTLISTCOUNTER)) (TESTS RESTLIST)) (COMS (* \; "Closure tests") (FNS CLOSURETESTER CLOSUREMAINTEST CLOSUREMAINTEST.RECURSE CLOSUREFNCHECK CLOSUREFNCHECK2 CLOSUREFN1 CLOSUREFN1VALUE CLOSUREFN2 CLOSUREFN2VALUE CLOSUREFN4CODE CLOSUREFN4VALUE) (INITVARS (CLOSURETEST.DEPTH 50) (CLOSURETEST.ENVIRONMENT "Closure Environment")) (GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT) (TESTS CLOSURES)) (COMS (* \; "Free-variable lookup") (FNS FVARTEST0 FVARTEST1 FVARTEST2 FVARTEST3) (TESTS FREE-VAR-LOOKUP)) (COMS (* \; "AREF opcode tests") (VARS (*NON-CONSTANT-FLOAT-1* 1.0)) (XCL-USER::VERIFIED-TESTS XCL-USER::AREF1-BIT XCL-USER::AREF1-BYTE XCL-USER::AREF1-WORD XCL-USER::AREF1-SIGNED-WORD XCL-USER::AREF1-FIXP XCL-USER::AREF1-FLOATP XCL-USER::AREF1-STRING-CHAR XCL-USER::AREF1-POINTER XCL-USER::AREF1-XPOINTER XCL-USER::AREF1-PUNT) (* |;;| "array-read and array-write ") (XCL-USER::VERIFIED-TESTS XCL-USER::ARRAY-READ-BIT XCL-USER::ARRAY-READ-BYTE XCL-USER::ARRAY-READ-WORD XCL-USER::ARRAY-READ-SIGNED-WORD XCL-USER::ARRAY-READ-FIXP XCL-USER::ARRAY-READ-FLOATP XCL-USER::ARRAY-READ-THIN-CHAR XCL-USER::ARRAY-READ-FAT-CHAR XCL-USER::ARRAY-READ-POINTER XCL-USER::ARRAY-READ-XPOINTER) (XCL-USER::VERIFIED-TESTS XCL-USER::ARRAY-WRITE-BIT XCL-USER::ARRAY-WRITE-BYTE XCL-USER::ARRAY-WRITE-WORD XCL-USER::ARRAY-WRITE-SIGNED-WORD XCL-USER::ARRAY-WRITE-FIXP XCL-USER::ARRAY-WRITE-FLOATP XCL-USER::ARRAY-WRITE-THIN-CHAR XCL-USER::ARRAY-WRITE-FAT-CHAR XCL-USER::ARRAY-WRITE-POINTER XCL-USER::ARRAY-WRITE-XPOINTER)) (COMS (* |;;| "Boxed opcodes") (VARS (*NON-CONSTANT-T* T) (*NON-CONSTANT-0* 0)) (XCL-USER::VERIFIED-TESTS XCL-USER::INT+ XCL-USER::FLOAT+ XCL-USER::MIXED+) (TESTS ERROR+) (XCL-USER::VERIFIED-TESTS XCL-USER::INT- XCL-USER::FLOAT- XCL-USER::MIXED-) (XCL-USER::VERIFIED-TESTS XCL-USER::INT* XCL-USER::FLOAT* XCL-USER::MIXED*) (XCL-USER::VERIFIED-TESTS XCL-USER::INT/ XCL-USER::FLOAT/ XCL-USER::MIXED/) (TESTS ERROR/T ERROR/0 NO-ERROR-0/0) (XCL-USER::VERIFIED-TESTS XCL-USER::INT> XCL-USER::FLOAT> XCL-USER::MIXED>)) (COMS (* |;;| "Unboxed opcodes [scalar]") (* |;;| "Ubfloat1") (XCL-USER::VERIFIED-TESTS XCL-USER::BOX XCL-USER::UNBOX XCL-USER::UBABS XCL-USER::UBNEGATE XCL-USER::UBFIX) (* |;;| "Ubfloat2") (XCL-USER::VERIFIED-TESTS XCL-USER::UB+ XCL-USER::UB- XCL-USER::UB* XCL-USER::UB/ XCL-USER::UB> XCL-USER::UBMAX XCL-USER::UBMIN) (* |;;| "Ubfloat3") (XCL-USER::VERIFIED-TESTS XCL-USER::POLY)) (COMS (* |;;| "Transcendentals --- stress test") (XCL-USER::VERIFIED-TESTS XCL-USER::SIN-TEST XCL-USER::COS-TEST XCL-USER::EXP-TEST XCL-USER::LOG-TEST)) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA DORESTLISTTEST DOFINDKEYTEST)))))
-
-
-
-(* |;;| "This file contains tests for the various opcodes used in the system.")

-
-
-(RPAQ *TEST-FILE-NAME* "OPCODES")
-
-
-
-(* \; "BITBLT")

-
-
-(CL:DEFUN SIMULATE-PILOTBITBLT (BBT LOW-WORD-ADDR HI-WORD-ADDR) (* |;;| "A translation of the algorithm in the Mesa PrincOps.") (* |;;| " S-L-O-W !!!") (LET ((SRC.WORD (FETCH (PILOTBBT PBTSOURCE) OF BBT)) (SRC.BIT (FETCH (PILOTBBT PBTSOURCEBIT) OF BBT)) (SRC.BPL (FETCH (PILOTBBT PBTSOURCEBPL) OF BBT)) (DST.WORD (FETCH (PILOTBBT PBTDEST) OF BBT)) (DST.BIT (FETCH (PILOTBBT PBTDESTBIT) OF BBT)) (DST.BPL (FETCH (PILOTBBT PBTDESTBPL) OF BBT)) (BBT.WIDTH (FETCH (PILOTBBT PBTWIDTH) OF BBT)) (BBT.HEIGHT (FETCH (PILOTBBT PBTHEIGHT) OF BBT)) (BOOL-OP (LET ((COMPLEMENT? (NOT (CL:ZEROP (FETCH (PILOTBBT PBTSOURCETYPE) OF BBT))))) (CL:ECASE (FETCH (PILOTBBT PBTOPERATION) OF BBT) ((0) (CL:IF COMPLEMENT? CL:BOOLE-C1 CL:BOOLE-1)) ((1) (CL:IF COMPLEMENT? CL:BOOLE-ANDC1 CL:BOOLE-AND)) ((2) (CL:IF COMPLEMENT? CL:BOOLE-ORC1 CL:BOOLE-IOR)) ((3) (CL:IF COMPLEMENT? CL:BOOLE-EQV CL:BOOLE-XOR))))) (GRAY? (FETCH (PILOTBBT PBTUSEGRAY) OF BBT)) (GRAY.WIDTH (ITIMES (ADD1 (FETCH (PILOTBBT PBTGRAYWIDTHLESSONE) OF BBT)) 16)) (GRAY.HEIGHT (ADD1 (FETCH (PILOTBBT PBTGRAYHEIGHTLESSONE) OF BBT))) LINE GRAY.BUMP LAST-GRAY Y-FORWARD? X-FORWARD?) (CL:LABELS ((MODIFY-BIT (DSTWORD DSTBIT DSTOFFSET SRCWORD SRCBIT SRCOFFSET) (CL:MULTIPLE-VALUE-BIND (SRCWORD SRCBIT) (BUMP SRCWORD SRCBIT SRCOFFSET) (CL:MULTIPLE-VALUE-BIND (DSTWORD DSTBIT) (BUMP DSTWORD DSTBIT DSTOFFSET) (ADDR-IN-RANGE LOW-WORD-ADDR DSTWORD HI-WORD-ADDR) (CL:SETF (LDB (BYTE 1 (IDIFFERENCE 15 DSTBIT)) (GETBASE DSTWORD 0)) (CL:BOOLE BOOL-OP (LDB (BYTE 1 (IDIFFERENCE 15 SRCBIT)) (GETBASE SRCWORD 0)) (LDB (BYTE 1 (IDIFFERENCE 15 DSTBIT)) (GETBASE DSTWORD 0))))))) (BITBLT-ITEM NIL (LET ((OFFSET (CL:IF X-FORWARD? 0 (SUB1 BBT.WIDTH)))) (FRPTQ BBT.WIDTH (LET ((POS (CL:IF GRAY? (IDIFFERENCE (IMOD (IPLUS OFFSET SRC.BIT) (ABS GRAY.WIDTH)) SRC.BIT) OFFSET))) (MODIFY-BIT DST.WORD DST.BIT OFFSET SRC.WORD SRC.BIT POS)) (CL:INCF OFFSET (CL:IF X-FORWARD? 1 -1))))) (SETUP NIL (CL:WHEN GRAY? (SETQ GRAY.BUMP (IMINUS (ITIMES GRAY.WIDTH (SUB1 GRAY.HEIGHT))))) (COMPUTE-DIRECTION) (CL:WHEN GRAY? (SETQ LAST-GRAY (CL:IF Y-FORWARD? (IDIFFERENCE GRAY.HEIGHT 1 (FETCH (PILOTBBT PBTGRAYOFFSET) OF BBT)) (FETCH (PILOTBBT PBTGRAYOFFSET) OF BBT)))) (SETQ LINE (CL:IF Y-FORWARD? 0 (SUB1 BBT.HEIGHT)))) (COMPUTE-DIRECTION NIL (SETQ Y-FORWARD? (SETQ X-FORWARD? (NOT (FETCH (PILOTBBT PBTBACKWARD) OF BBT)))))) (SETUP) (WHILE (AND (ILEQ 0 LINE) (ILESSP LINE BBT.HEIGHT)) DO (BITBLT-ITEM) (BLOCK) (* \; "just to be nice.") (CL:MULTIPLE-VALUE-SETQ (SRC.WORD SRC.BIT) (BUMP SRC.WORD SRC.BIT (CL:IF GRAY? (CL:IF (= (IMOD LINE GRAY.HEIGHT) LAST-GRAY) GRAY.BUMP GRAY.WIDTH) SRC.BPL))) (CL:MULTIPLE-VALUE-SETQ (DST.WORD DST.BIT) (BUMP DST.WORD DST.BIT DST.BPL)) (CL:INCF LINE (CL:IF Y-FORWARD? 1 -1))))))
-
-(CL:DEFUN BUMP (WORD BIT INCR) (CL:MULTIPLE-VALUE-BIND (WORD-INCR NEW-BIT) (CL:FLOOR (IPLUS BIT INCR) 16) (CL:VALUES (ADDBASE WORD WORD-INCR) NEW-BIT)))
-
-(CL:DEFUN SLOPED-LINES (W) (LET* ((FEEDBACK-INTERVAL (QUOTIENT W 20)) (NEXT-FEEDBACK 0) (BLACK #16*1) (A (CL:MAKE-ARRAY (LIST W W) :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) (LOW-ADDR (FETCH (ARRAYP BASE) OF A)) (HI-ADDR (\\ADDBASE LOW-ADDR (IQUOTIENT (+ 15 (ITIMES W W)) 16))) (DA (CL:MAKE-ARRAY (ITIMES W W) :ELEMENT-TYPE (QUOTE BIT) :DISPLACED-TO A)) (R (CL:MAKE-ARRAY (LIST W W) :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) (DR (CL:MAKE-ARRAY (ITIMES W W) :ELEMENT-TYPE (QUOTE BIT) :DISPLACED-TO R)) (BBT (CREATE PILOTBBT PBTDEST _ (FETCH (ARRAY-HEADER BASE) OF A) PBTDESTBIT _ 0 PBTSOURCE _ (FETCH (ARRAY-HEADER BASE) OF BLACK) PBTSOURCEBIT _ 0 PBTGRAYOFFSET _ 0 PBTGRAYWIDTHLESSONE _ 0 PBTGRAYHEIGHTLESSONE _ 0 PBTWIDTH _ 0 PBTDISJOINT _ T PBTUSEGRAY _ T))) (CL:DOTIMES (SLOPE W) (CL:WHEN (> SLOPE NEXT-FEEDBACK) (CL:PRINC #\. *ERROR-OUTPUT*) (CL:INCF NEXT-FEEDBACK FEEDBACK-INTERVAL)) (CL:FILL DA 0) (REPLACE (PILOTBBT PBTDESTBPL) OF BBT WITH (IPLUS W SLOPE 1)) (CL:INCF (FETCH (PILOTBBT PBTWIDTH) OF BBT)) (REPLACE (PILOTBBT PBTHEIGHT) OF BBT WITH (CL:CEILING W (ADD1 SLOPE))) (\\PILOTBITBLT BBT NIL) (CL:FILL DR 0) (SIMULATE-PILOTBITBLT (CREATE PILOTBBT USING BBT PBTDEST _ (FETCH (ARRAY-HEADER BASE) OF R)) LOW-ADDR HI-ADDR) (CL:WHEN (NOT (CL:EQUAL DA DR)) (CL:CERROR "Try the next one" "Bad BITBLT: diagonal w: ~D slope: ~D" W SLOPE)))))
-
-(CL:DEFUN DIAGONALS (W SKIP-SIMULATION SKIP-UCODE) (* |;;| "Draw both diagonals in a square of size W.") (* |;;| "if SKIP-SIMULATION is not NIL, don't bother with the simulation or a consistency check.") (* |;;| "if SKIP-UCODE is not NIL, don't bother with the real microcode version or a consistency check.") (LET* ((FAILURES NIL) (BLACK #16*1) (A (CL:MAKE-ARRAY (LIST W W) :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) (LOW-ADDR (FETCH (ARRAYP BASE) OF A)) (HI-ADDR (SUB1 (\\ADDBASE LOW-ADDR (IQUOTIENT (+ 15 (ITIMES W W)) 16)))) (A-BASE (FETCH (ARRAY-HEADER BASE) OF A)) (DA (CL:MAKE-ARRAY (ITIMES W W) :ELEMENT-TYPE (QUOTE BIT) :DISPLACED-TO A)) (R (CL:MAKE-ARRAY (LIST W W) :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) (R-BASE (FETCH (ARRAY-HEADER BASE) OF R)) (DR (CL:MAKE-ARRAY (ITIMES W W) :ELEMENT-TYPE (QUOTE BIT) :DISPLACED-TO R)) (BBT (CREATE PILOTBBT PBTSOURCE _ (FETCH (ARRAY-HEADER BASE) OF BLACK) PBTSOURCEBIT _ 0 PBTGRAYOFFSET _ 0 PBTGRAYWIDTHLESSONE _ 0 PBTGRAYHEIGHTLESSONE _ 0 PBTWIDTH _ 1 PBTHEIGHT _ W PBTDISJOINT _ T PBTUSEGRAY _ T))) (CL:MACROLET ((CLEAR (WHICH) (BQUOTE (CL:FILL (\\\, WHICH) 0)))) (CL:LABELS ((SET-SOURCE (BBT BASE INCREMENT) (CL:MULTIPLE-VALUE-BIND (WORD BIT) (BUMP BASE 0 INCREMENT) (REPLACE (PILOTBBT PBTDEST) OF BBT WITH WORD) (REPLACE (PILOTBBT PBTDESTBIT) OF BBT WITH BIT)) BBT) (CHECK-RESULT (FROM TO START-OFFSET) (CLEAR DR) (CL:UNLESS SKIP-SIMULATION (* |;;| "Only run this if we need the simulation.") (SIMULATE-PILOTBITBLT (SET-SOURCE (CREATE PILOTBBT USING BBT) R-BASE START-OFFSET) LOW-ADDR HI-ADDR)) (CL:UNLESS (OR SKIP-SIMULATION SKIP-UCODE) (* |;;| "Only check the results if we ran both versions.") (CL:WHEN (NOT (CL:EQUAL DA DR)) (CL:PUSH (CL:CONCATENATE (QUOTE STRING) FROM " to " TO) FAILURES) (CL:CERROR "Try the next one" "Bad BITBLT: ~A to ~A diagonal w: ~D " FROM TO W)))) (DO-ONE (FROM TO START-OFFSET BPL) (CLEAR DA) (REPLACE (PILOTBBT PBTDESTBPL) OF BBT WITH BPL) (REPLACE (PILOTBBT PBTBACKWARD) OF BBT WITH (ILESSP BPL 0)) (OR SKIP-UCODE (\\PILOTBITBLT (SET-SOURCE BBT A-BASE START-OFFSET) NIL)) (CHECK-RESULT FROM TO START-OFFSET))) (DO-ONE "upper left" "lower right" 0 (ADD1 W)) (DO-ONE "upper right" "lower left" (SUB1 W) (SUB1 W)) (DO-ONE "lower left" "upper right" (ITIMES W (SUB1 W)) (IMINUS (SUB1 W))) (DO-ONE "lower right" "upper left" (SUB1 (ITIMES W W)) (IMINUS (ADD1 W))))) (CL:VALUES (NOT FAILURES) FAILURES)))
-(DEFINEQ
-
-(ADDR-IN-RANGE

-(LAMBDA (LOW ADDR HI) (* \; "Edited 16-Nov-88 14:32 by jds") (OR (<= (+ (LLSH (HILOC LOW) 16) (LOLOC LOW)) (+ (LLSH (HILOC ADDR) 16) (LOLOC ADDR)) (+ (LLSH (HILOC HI) 16) (LOLOC HI))) (HELP)))
-)
-)
-
-(DEFTEST (BITBLT-DIAGONALS :COMPILED) (FOR WIDTH IN (QUOTE (1 2 3 4 5 7 8 9 15 16 17 31 32 33 39 40 41)) ALWAYS (PRINT WIDTH) (* \; "DD") (DIAGONALS WIDTH)))
-
-(DEFTEST (BITBLT-SLOPED-LINES :COMPILED) (FOR I IN (QUOTE (1 3 4 5 7 8 9 15 16 17)) DO (SLOPED-LINES I)) T)
-
-
-
-(* \; "COPY.N")

-
-
-(CL:DEFUN XCL-USER::COPY.N.TEST (XCL-USER::USE-UFN) "Tests a case of the COPY.N opcode. Both (COPY.N.TEST NIL) and (COPY.N.TEST T) should return :OK" (CL:IF XCL-USER::USE-UFN (PROGN ((OPCODES COPY) 2 1 :OK -1 -2) (CL:FUNCALL (\\GETUFNENTRY (QUOTE COPY.N)) 4)) ((OPCODES COPY.N 4) 2 1 :OK -1 -2)))
-
-(DEFTEST (COPY.N :COMPILED) (* |;;| "COPY.N  opcode") (EQ :OK (XCL-USER::COPY.N.TEST)))
-
-(DEFTEST COPY.N-UFN (EQ :OK (XCL-USER::COPY.N.TEST T)))
-
-
-
-(* \; "STORE.N")

-
-
-(CL:DEFUN XCL-USER::STORE.N.TEST (XCL-USER::USE-UFN) "Tests a case of the STORE.N opcode. Both (STORE.N.TEST NIL) and (STORE.N.TEST T) should return the list (5 4 t 2 1)" (CL:IF XCL-USER::USE-UFN (PROGN ((OPCODES COPY) 5 4 3 2 1) (CL:FUNCALL (\\GETUFNENTRY (QUOTE STORE.N)) T 4)) ((OPCODES STORE.N 4) 5 4 3 2 1 T)) ((OPCODES APPLYFN) 5 (QUOTE LIST)))
-
-(DEFTEST (STORE.N :COMPILED) (* |;;| "COPY.N  opcode") (EQUAL (QUOTE (5 4 T 2 1)) (XCL-USER::STORE.N.TEST)))
-
-(DEFTEST STORE.N-UFN (* |;;| "STORE.N  opcode") (EQUAL (QUOTE (5 4 T 2 1)) (XCL-USER::STORE.N.TEST T)))
-
-
-
-(* \; "POP.N")

-
-
-(CL:DEFUN XCL-USER::POP.N.TEST (XCL-USER::USE-UFN) "Tests a case of the STORE.N opcode. Both (POP.N.TEST NIL) and (POP.N.TEST T) should return 2" (CL:IF XCL-USER::USE-UFN (PROGN ((OPCODES COPY) 4 3 2 1 0) (CL:FUNCALL (\\GETUFNENTRY (QUOTE POP.N)) 2)) ((OPCODES POP.N 2) 4 3 2 1 0)))
-
-(DEFTEST (POP.N :COMPILED) (= 3 (XCL-USER::POP.N.TEST)))
-
-(DEFTEST POP.N-UFN (= 3 (XCL-USER::POP.N.TEST T)))
-
-
-
-(* \; "UNWIND")

-
-
-(DEFTEST UNWIND-OFF-BY-1-A (LET ((F CL:PI)) (EQUAL (LIST (QUOTE SUCCESS) (PROGN (|for| C |in| (UNPACK F) |do| (PRIN1 C)) F)) (QUOTE (SUCCESS 3.1415927)))))
-
-(DEFTEST UNWIND-OFF-BY-1-B (* |;;| "Make sure that UNWIND doesn't mung the binding for F during the for loop.") (LET ((F CL:PI)) (|for| C |in| (UNPACK F) |do| (PRIN1 C)) (AND (FLOATP F) (= F CL:PI))))
-(DEFINEQ
-
-(UNWINDTESTER

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 26-Sep-88 14:11 by bvm")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH)
-       |do|
 (LET ((VALUE (UNWINDMAINTEST
 D (LOGAND D 7))))
-                     (COND
-                        ((NEQ VALUE 'SUCCESS)
-                         (HELP "UNWINDMAINTEST did not return correctly" VALUE)))))
-    T))
-
-(UNWINDMAINTEST

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:10 by bvm")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET ((*B* 3)
-              (*C* 2)
-              (*D* DEPTH))
-             (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-             (LIST (UNWINDCHECK1
 DEPTH)
-                   (LET ((*E* 10)
-                         (*F* 11)
-                         (*G* 12)
-                         (*H* DEPTH))
-                        (DECLARE
 (CL:SPECIAL *E* *F* *G* *H*))
-
-                        (* |;;| "There are 8 pvar slots in this frame (for 7 pvars), so empty stack = 8+2 = 10.  Right now the stack depth is up to 13, because of two bind marks and the value returned from UNWINDCHECK1.")

-
-                        (UNWINDCHECKFAIL T *B* *C* *D* *E* *F* 'PREVPREV 'PREVIOUS-VALUE
-                               (PROGN                        (* \; 
-
                            "Unwind stack to depth 10 + {0,1,3,6} preserving tos when code is even")

-                                      (SELECTQ CODE
-                                          (0                 (* \; "Blow away whole stack")

-                                             ((OPCODES UNWIND 10 0)))
-                                          (1                 (* \; "Same as 0 but keep tos")

-                                             ((OPCODES UNWIND 10 1)))
-                                          (2                 (* \; "Blow away second binding only")

-                                             ((OPCODES UNWIND 11 0)))
-                                          (3                 (* \; "Same as 2 but keep tos")

-                                             ((OPCODES UNWIND 11 1)))
-                                          (4                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 13 0)))
-                                          (5                 (* \; "Same as 4 but keep tos")

-                                             ((OPCODES UNWIND 13 1)))
-                                          (6                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 16 0)))
-                                          ((OPCODES UNWIND 16 1))))
-                               (PROGN                        (* \; 
-
                                     "Check that previous opcode left the stack in the right state")

-                                      (UNWINDCHECK2
 CODE)))))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UNWINDMAINTEST.RECURSE
 (SUB1 DEPTH)
-                 CODE)))))
-
-(UNWINDMAINTEST.RECURSE

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:08 by bvm")

-    (UNWINDMAINTEST
 DEPTH CODE)))
-
-(UNWINDCHECK1

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 13:15")

-                                                             (* \; 
-
                                                "This just prevents compiler from merging specials")

-    NIL))
-
-(UNWINDCHECK2

-  (LAMBDA (CODE)
                                         (* \; "Edited 26-Sep-88 14:10 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.  TOS should be PREVIOUS-VALUE if the UNWIND said to preserve TOS.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD (+ 10 (LOGAND CODE 1)
-                                  (SELECTQ (LRSH CODE 1)
-                                      (0 0)
-                                      (1 1)
-                                      (2 3)
-                                      6))
-                              WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT (UNWINDCODE
 CODE)
-                           " unwound stack "
-                           (COND
-                              ((GREATERP GOODEOS EOS)
-                               "too far")
-                              (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words")))
-             ((AND (ODDP CODE)
-                   (NEQ (\\GETBASEPTR (ADDSTACKBASE (IDIFFERENCE EOS WORDSPERCELL))
-                               0)
-                        'PREVIOUS-VALUE))                    (* \; "Should have preserved tos")

-              (HELP (UNWINDCODE
 CODE)
-                    " did not preserve top of stack")))
-          (|for|
 V |in|
 '(*B* *C* *D* *E* *F* *G* *H*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (SELECTQ (LRSH CODE 1)
-                                                 (0 T)
-                                                 (1 (FMEMB V '(*E* *F* *G* *H*)))
-                                                 NIL))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT (UNWINDCODE
 CODE)
-                                                         " left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT (UNWINDCODE
 CODE)
-                                    " left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from UNWINDMAINTEST because the UNWIND there has ruined its stack")

-
-                 (RETFROM 'UNWINDMAINTEST 'SUCCESS)))))
-
-(UNWINDCODE

-  (LAMBDA (CODE)
                                         (* |bvm:| "21-Jul-86 15:34")

-    (CONCAT "UNWIND." (PLUS 10 (LOGAND CODE 1))
-           "."
-           (LRSH CODE 1))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD BINDMARKSLOT
 ((BINDMARKP FLAG) (NIL BITS 15)) (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD) (BINDLASTPVAR WORD)))
- (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN (* |Value| |stored| |in| |high| |half| |is| |one's| |complement| |of| |number| |of| |values| |bound|) (LOGXOR (|fetch| BINDNEGVALUES |of| DATUM) 65535)))))
-)
-)
-)
-(DEFINEQ
-
-(UW2.TEST

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 15:00 by vanmelle")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (UW2.TEST.MAIN
))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UW2.RECURSE
 (SUB1 DEPTH))))))
-
-(UW2.RECURSE

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 14:56 by vanmelle")

-                                                             (* \; "To foil compiler")

-    (UW2.TEST
 DEPTH)))
-
-(UW2.TEST.MAIN

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 20-Oct-88 15:49 by bvm")

-    (LET ((*B* 3)
-          (*C* 2.4)
-          (*D* DEPTH))
-         (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-         (LIST (UW2.IDENTITY
 'TOS)
-               (LET ((*E* 3.5))
-                    (DECLARE
 (CL:SPECIAL *E*))
-
-                    (* |;;| "There are 4 pvar slots in this frame, so empty stack = 4+2 = 6.  Right now the stack depth is up to 9, because of 2 bind marks and the value from NILL.")

-
-                    (UNWINDCHECKFAIL T NIL ((OPCODES UNWIND 9 0))
-                           (UW2.CHECK
)))))))
-
-(UW2.CHECK

-  (LAMBDA NIL
                                            (* \; "Edited 20-Oct-88 15:49 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD 9 WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT "Unwound stack " (COND
-                                                ((GREATERP GOODEOS EOS)
-                                                 "too far")
-                                                (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words"))))
-          (|for|
 V |in|
 '(*B* *C* *D* *E*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (AND NIL (EQ V '*E*)))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT "UNWIND left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT "UNWIND left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from test because the UNWIND there has confused its stack")

-
-                 (RETFROM 'UW2.TEST.MAIN 'SUCCESS)))))
-
-(UW2.IDENTITY

-  (LAMBDA (X)
                                            (* \; "Edited 20-Oct-88 15:19 by bvm")

-                                                             (* \; 
-
                                                           "Identity compiler doesn't know about")

-    X))
-)
-
-(DEFTEST (UNWIND :COMPILED) (UNWINDTESTER))
-
-(DEFTEST (UNWIND-2 :COMPILED) (FOR I FROM 0 TO 100 ALWAYS (EQ (QUOTE SUCCESS) (UW2.TEST I))))
-
-
-
-(* \; "FINDKEY")

-
-(DEFINEQ
-
-(FINDKEYTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "14-Jul-86 17:54")

-
-(* |;;;| "Test the opcode FINDKEY")

-
-    (DOFINDKEYTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)))
-
-(DOFINDKEYTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (FINDKEYCHECK 1 ||)
-         (FINDKEYCHECK 2 ||)
-         (FINDKEYCHECK 3 ||)
-         (FINDKEYCHECK 4 ||)
-         (FINDKEYCHECK 5 ||)
-         (FINDKEYCHECK 6 ||)
-         (FINDKEYCHECK 7 ||)
-         (FINDKEYCHECK 8 ||)
-         (FINDKEYCHECK 1 KEYB)
-         (FINDKEYCHECK 2 KEYB)
-         (FINDKEYCHECK 3 KEYB)
-         (FINDKEYCHECK 4 KEYB)
-         (FINDKEYCHECK 5 KEYB)
-         (FINDKEYCHECK 6 KEYB)
-         (FINDKEYCHECK 7 KEYB)
-         (FINDKEYCHECK 8 KEYB)
-         (FINDKEYCHECK 1 KEYC)
-         (FINDKEYCHECK 2 KEYC)
-         (FINDKEYCHECK 3 KEYC)
-         (FINDKEYCHECK 4 KEYC)
-         (FINDKEYCHECK 5 KEYC)
-         (FINDKEYCHECK 6 KEYC)
-         (FINDKEYCHECK 7 KEYC)
-         (FINDKEYCHECK 8 KEYC))))
-
-(DOFINDKEYTEST1

-  (LAMBDA (RESULT N KEY)
                                 (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (LET ((ANSWER (|for|
 I |from|
 N |by|
 2 |to|
 KEYARGS
-                     |when|
 (EQ KEY (ARG KEYARGS I)) |do|
 (RETURN (ADD1 I)))))
-         (COND
-            ((NEQ ANSWER RESULT)
-             (HELP (CONCAT "FINDKEY." N " returned " RESULT " instead of " ANSWER " for ")
-                   KEY))
-            (T T)))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS FINDKEYCHECK DMACRO (DEFMACRO (N KEY) (BQUOTE (DOFINDKEYTEST1 ((OPCODES FINDKEY (\\\, N)) (QUOTE (\\\, KEY))) (\\\, N) (QUOTE (\\\, KEY))))))
-)
-)
-
-(DEFTEST (FINDKEY :COMPILED) (FINDKEYTESTER))
-
-
-
-(* \; "RESTLIST")

-
-(DEFINEQ
-
-(\\RESTLIST.SPLICE.FRAME

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:13")

-
-(* |;;;| "If caller is fast, so its BF is contiguous with its caller's FX, then adjust pointers so that its first ivar goes back on it's caller's fx, and back up pc")

-
-    (UNINTERRUPTABLY
-        (LET ((CALLER (\\MYALINK))
-              CALLER2 IVAR BF)
-             (COND
-                ((AND (|fetch|
 (FX FASTP) |of|
 CALLER)
-                      (EQ (SETQ IVAR (|fetch|
 (BF IVAR) |of|
 (SETQ BF (|fetch|

-                                                                               (FX DUMMYBF)
-                                                                                 |of|
 CALLER))))
-                          (|fetch|
 (FX NEXTBLOCK) |of|
 (SETQ CALLER2 (|fetch|

-                                                                              (FX ALINK) |of|

-                                                                                         CALLER)))))
-                 (|replace|
 (BF IVAR) |of|
 BF |with|
 (|add|
 IVAR WORDSPERCELL))
-                 (|replace|
 (FX NEXTBLOCK) |of|
 CALLER2 |with|
 IVAR)
-                 (|add|
 (|fetch|
 (FX PC) |of|
 CALLER2)
-                        -2)
-                 T))))))
-
-(RESTLISTTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:28")

-
-(* |;;;| "Test the opcode RESTLIST")

-
-    (AND (DORESTLISTTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)
-         (DORESTLISTTEST
 '(||)
-                '(VALA)
-                '(KEYB)
-                'VALB
-                '(KEYC)
-                '(VALC))
-         (DORESTLISTTEST
)
-         (\\COMPUTED.FORM (CONS 'DORESTLISTTEST (|for|
 I |from|
 1 |to|
 200
-                                                   |collect|
 `',(LIST I)))))))
-
-(DORESTLISTTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:39")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (RESTLISTCHECK 1)
-         (RESTLISTCHECK 2)
-         (RESTLISTCHECK 3)
-         (RESTLISTCHECK 4)
-         (RESTLISTCHECK 5)
-         (RESTLISTCHECK 6)
-         (RESTLISTCHECK 7)
-         (RESTLISTCHECK 8))))
-
-(GETRESTARGREFCNTS

-  (LAMBDA (N)
-    (DECLARE
 (USEDFREE KEYARGS))
                     (* |bvm:| "18-Jul-86 15:01")

-    (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (\\REFCNT (ARG KEYARGS I)))))
-
-(DORESTLISTTEST1

-  (LAMBDA (REFCNTS RESULT N)
                             (* |bvm:| "21-Jul-86 17:22")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (COND
-       ((OR (NOT (EQLENGTH RESULT (IMAX (IDIFFERENCE KEYARGS (SUB1 N))
-                                        0)))
-            (|for|
 R |in|
 RESULT |as|
 I |from|
 N |to|
 KEYARGS
-               |thereis|
 (NEQ R (ARG KEYARGS I))))
-        (HELP (CONCAT "RESTLIST." N " returned " RESULT " instead of "
-                     (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (ARG KEYARGS I))))))
-    (|for|
 TAIL |on|
 RESULT |as|
 CNT |in|
 REFCNTS |as|
 I |from|
 1
-       |do|
 (COND
-                   ((AND (NEQ (\\REFCNT (CAR TAIL))
-                              (ADD1 CNT))
-                         (NOT (|fetch|
 (MDSTYPEWORD NOREFCNT)
-                                 |of|
 (\\ADDBASE |\\MDSTypeTable| (LRSH (|fetch|
 (POINTER
-                                                                                          PAGE#)
-                                                                               |of|
 (CAR TAIL))
-                                                                            1)))))
-                    (HELP (CONCAT "Ref cnt of " I "th RESTLIST element was not incremented")
-                          (CONCAT "Was " CNT ", now is " (\\REFCNT (CAR TAIL)))))
-                   ((NEQ (\\REFCNT TAIL)
-                         (COND
-                            ((EQ TAIL RESULT)
-                             0)
-                            (T 1)))
-                    (HELP (COND
-                             ((EQ TAIL RESULT)
-                              "Ref cnt of RESTLIST value is not zero")
-                             (T "Ref cnt of RESTLIST tail is not one"))
-                          (\\REFCNT TAIL)))))
-    T))
-)
-
-(RPAQ? RESTLISTCOUNTER 0)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS RESTLISTCHECK DMACRO (DEFMACRO (N) (BQUOTE (PROGN (RECLAIM) (DORESTLISTTEST1 (GETRESTARGREFCNTS (\\\, N)) ((OPCODES RESTLIST (\\\, N)) NIL KEYARGS) (\\\, N))))))
-
-(PUTPROPS \\COMPUTED.FORM MACRO (X (CONS (QUOTE PROGN) (MAPCAR X (FUNCTION EVAL)))))
-)
-
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD MDSTYPEWORD
 ((NOREFCNT FLAG) (NIL BITS 15)))
-)
-
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS RESTLISTCOUNTER)
-)
-)
-
-(DEFTEST (RESTLIST :COMPILED) (RESTLISTTESTER))
-
-
-
-(* \; "Closure tests")

-
-(DEFINEQ
-
-(CLOSURETESTER

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH) |always|
 (CLOSUREMAINTEST

-                                                                                  D))))
-
-(CLOSUREMAINTEST

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET (VALUE)
-             (PUTD 'CLOSUREFN4 (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM DEFPOINTER)
-                                                         |of|
 'CLOSUREFN4CODE)
-                                      CLOSURETEST.ENVIRONMENT))
-             (COND
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (GETD 'CLOSUREFN1)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN1VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN1 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM 
-                                                                                           DEFPOINTER
-                                                                                             )
-                                                                            |of|
 'CLOSUREFN2)
-                                                         CLOSURETEST.ENVIRONMENT)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN2VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN2 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (CLOSUREFN4))
-                             (CLOSUREFN4VALUE
)))
-                 (HELP "CLOSUREFN4 returned the wrong value" VALUE))
-                (T T))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (CLOSUREMAINTEST.RECURSE
 (SUB1 DEPTH))))))
-
-(CLOSUREMAINTEST.RECURSE

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "18-Jul-86 14:07")

-    (CLOSUREMAINTEST
 DEPTH)))
-
-(CLOSUREFNCHECK

-  (LAMBDA (CLOSUREP FUNCALLP)
                            (* |bvm:| "18-Jul-86 14:48")

-    (LET* ((CALLER (\\MYALINK))
-           (PVAR0 (STACKADDBASE (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER))))
-          (COND
-             (CLOSUREP (COND
-                          ((NEQ (\\GETBASEPTR PVAR0 0)
-                                CLOSURETEST.ENVIRONMENT)
-                           (HELP (COND
-                                    (FUNCALLP "FUNCALL of a full closure")
-                                    (T "Call to symbol with Closure definition"))
-                                 " did not store closure environment in pvar0"))))
-             ((|fetch|
 (PVARSLOT BOUND) |of|
 PVAR0)
-              (HELP "FUNCALL of a null closure stored something into pvar0"))))))
-
-(CLOSUREFNCHECK2

-  (LAMBDA NIL
                                            (* |bvm:| "18-Jul-86 14:51")

-                                                             (* \; 
-
                                                           "Nothing really to check for now")

-    NIL))
-
-(CLOSUREFN1

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN1VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN1VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-    (LIST ARG1 ARG2 ARG3 ARG4)))
-
-(CLOSUREFN2

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 T T)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN2VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN2VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-    (LIST ARG4 ARG3 ARG2 ARG1)))
-
-(CLOSUREFN4CODE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:53")

-                                                             (* \; "closure called via FNx")

-    (CLOSUREFNCHECK
 T NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN4VALUE
 ARG1 ARG2 ARG3))))
-
-(CLOSUREFN4VALUE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:38")

-    (LIST ARG2 ARG3 ARG1)))
-)
-
-(RPAQ? CLOSURETEST.DEPTH 50)
-
-(RPAQ? CLOSURETEST.ENVIRONMENT "Closure Environment")
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT)
-)
-
-(DEFTEST (CLOSURES :COMPILED) (CLOSURETESTER))
-
-
-
-(* \; "Free-variable lookup")

-
-(DEFINEQ
-
-(FVARTEST0

-(LAMBDA NIL (* \; "Edited  2-Aug-88 23:04 by FS") (SETTOPVAL (QUOTE TOPLEVEL1) 1) (SETTOPVAL (QUOTE TOPLEVEL2) 2) (SETTOPVAL (QUOTE NITERS) 3) (EQ (ITIMES NITERS 334) (FVARTEST1 100 200 4)))
-)
-
-(FVARTEST1

-(LAMBDA (IVAR1 IVAR2 DEPTH) (* \; "Edited  2-Aug-88 23:02 by FS") (* |;;| "Recurse DEPTH times and then call FVARTEST2 to test free variable lookup.") (LET (PVAR1) (* |;;| "This block is here so that name table scanning will find it, but must skip it.  PRINT so the compiler won't throw the block away.") (SETQ PVAR1 DEPTH) (PRINTOUT T "AT DEPTH " PVAR1 T)) (LET (PVAR1 PVAR2) (SETQ PVAR1 10) (SETQ PVAR2 20) (COND ((<= DEPTH 0) (FVARTEST2 4)) (T (FVARTEST1 IVAR1 IVAR2 (SUB1 DEPTH))))))
-)
-
-(FVARTEST2

-(LAMBDA (DEPTH) (* \; "Edited  2-Aug-88 22:56 by FS") (* |;;| "Recurse DEPTH times and then freely reference IVars, PVars, Globals.") (* |;;| "") (* |;;| "It needs to search past its own frames (the vars are unbound), and past FVARTEST1's frames for the globals.") (* |;;| "") (* |;;| "It will  find IVARx, PVARx in FVARTEST1's frames.") (* |;;| "") (* |;;| " Loop based on the freely referenced NITERS, to test FVAR  caching.") (PROG (NAMETBLE1 NAMETBLE2 TOTAL) (COND ((<= DEPTH 0) (SETQ TOTAL 0) (|for| I |from| 1 |to| NITERS |do| (SETQ TOTAL (+ TOTAL IVAR1 IVAR2 PVAR1 PVAR2 TOPLEVEL1 TOPLEVEL2 (FVARTEST3)))) (RETURN TOTAL)) (T (RETURN (FVARTEST2 (SUB1 DEPTH)))))))
-)
-
-(FVARTEST3

-(LAMBDA NIL (* \; "Edited  2-Aug-88 22:54 by FS") (* |;;| "Should find TOPLEVEL1 in FVARTEST2's frame (no way to test if this is really happening, but it should test a branch of the C code.") TOPLEVEL1)
-)
-)
-
-(DEFTEST FREE-VAR-LOOKUP (FVARTEST0))
-
-
-
-(* \; "AREF opcode tests")

-
-
-(RPAQQ *NON-CONSTANT-FLOAT-1* 1.0)
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-BIT "Opcode aref1, type (unsigned-byte 1)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 1)) :INITIAL-CONTENTS (QUOTE (0 1 0 1)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 1)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-BYTE "Opcode aref1, type (unsigned-byte 8)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :INITIAL-CONTENTS (QUOTE (0 34 56 255 23)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-WORD "Opcode aref1, type (unsigned-byte 16)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 16)) :INITIAL-CONTENTS (QUOTE (0 34 255 65535 23)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 16)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-SIGNED-WORD "Opcode aref1, type (signed-byte 16)" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:SIGNED-BYTE 16)) :INITIAL-CONTENTS (QUOTE (0 -34 255 -32768 23))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-FIXP "Opcode aref1, type (signed-byte 32)" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:SIGNED-BYTE 32)) :INITIAL-CONTENTS (QUOTE (0 -34 258 -65538 2147483647))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-FLOATP "Opcode aref1, type single-float" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE CL:SINGLE-FLOAT) :INITIAL-CONTENTS (QUOTE (0.0 -34.0 3.456756E+35 -5.768E-34 5.4524))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-STRING-CHAR "Opcode aref1, type string-char" (LET ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 3 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :INITIAL-CONTENTS (QUOTE (#\Space #\a #\b)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 3 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :FATP T :INITIAL-CONTENTS (QUOTE (#\Space #\Greek-0 #\Greek-32))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 3) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-POINTER "Opcode aref1, type t" (LET* ((XCL-USER::LST (LIST 0 (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B)) (+ *NON-CONSTANT-FLOAT-1* 3.4) (QUOTE XCL-USER::C) (CONS (QUOTE XCL-USER::D) (QUOTE XCL-USER::E)))) (CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE T :INITIAL-CONTENTS XCL-USER::LST))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CONS (CL:AREF CL:ARRAY XCL-USER::I) (\\REFCNT (CL:AREF CL:ARRAY XCL-USER::I))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-XPOINTER "Opcode aref1, type il:xpointer" (LET* ((XCL-USER::LST (LIST 0 (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B)) (+ *NON-CONSTANT-FLOAT-1* 3.4) (QUOTE XCL-USER::C) (CONS (QUOTE XCL-USER::D) (QUOTE XCL-USER::E)))) (* |;;| "The IL:*NON-CONSTANT-FLOAT-1* is there to prevent using a constant float and getting screwed by refcount.") (CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE XPOINTER) :INITIAL-CONTENTS XCL-USER::LST))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CONS (CL:AREF CL:ARRAY XCL-USER::I) (\\REFCNT (CL:AREF CL:ARRAY XCL-USER::I))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-PUNT "Opcode aref1, punt cases" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :DISPLACED-TO (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :INITIAL-CONTENTS (QUOTE (#\a #\b #\c #\d))))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE T :ADJUSTABLE T :INITIAL-CONTENTS (QUOTE (0 XCL-USER::A XCL-USER::B (XCL-USER::A . XCL-USER::B))))) (XCL-USER::ARRAY-3 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :READ-ONLY-P T :INITIAL-CONTENTS (QUOTE (0 1 2 3))))) (* |;;| "aref1 should punt on all these cases") (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-3 XCL-USER::I))))))
-
-
-
-(* |;;| "array-read and array-write ")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-BIT "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 1)" (CL:FLET ((XCL-USER::ARRAY-READ-BIT (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 0 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 8 0))) (\\PUTBASEBYTE XCL-USER::BASE 0 160) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-BIT XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-BYTE "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 8)" (CL:FLET ((XCL-USER::ARRAY-READ-BYTE (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 3 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 3))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 4)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEBYTE XCL-USER::BASE XCL-USER::I (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-BYTE XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-WORD "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 16)" (CL:FLET ((XCL-USER::ARRAY-READ-WORD (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 4 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 4))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 65535)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-WORD XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-SIGNED-WORD "Opcode ARRAYREAD (MISC3 9), type (signed-byte 16)" (CL:FLET ((XCL-USER::ARRAY-READ-SIGNED-WORD (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 20 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 20))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 255 -32768)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (\\LOLOC (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-SIGNED-WORD XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FIXP "Opcode ARRAYREAD (MISC3 9), type (signed-byte 32)" (CL:FLET ((XCL-USER::ARRAY-READ-FIXP (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 22 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 22))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 65536 -2147483648)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEFIXP XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FIXP XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FLOATP "Opcode ARRAYREAD (MISC3 9), type single-float" (CL:FLET ((XCL-USER::ARRAY-READ-FLOATP (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 54 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 54))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0.0 -23.0 3.4456E+24 -4.562435E-12)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEFLOATP XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FLOATP XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-THIN-CHAR "Opcode ARRAYREAD (MISC3 9), type string-char" (CL:FLET ((XCL-USER::ARRAY-READ-THIN-CHAR (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 67 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 67))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEBYTE XCL-USER::BASE XCL-USER::I (CL:CHAR-CODE (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-THIN-CHAR XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FAT-CHAR "Opcode ARRAYREAD (MISC3 9), type fat-string-char" (CL:FLET ((XCL-USER::ARRAY-READ-FAT-CHAR (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 68 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 68))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (CL:CHAR-CODE (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FAT-CHAR XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-POINTER "Opcode ARRAYREAD (MISC3 9), type t" (CL:FLET ((XCL-USER::ARRAY-READ-POINTER (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 38 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 38))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (2 #\c 2.3 (XCL-USER::A . XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\RPLPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-POINTER XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-XPOINTER "Opcode ARRAYREAD (MISC3 9), type il:xpointer" (CL:FLET ((XCL-USER::ARRAY-READ-XPOINTER (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 86 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 86))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (2 #\c 2.3 (XCL-USER::A . XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-XPOINTER XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-BIT "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 1)" (CL:FLET ((XCL-USER::ARRAY-WRITE-BIT (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 0 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 8 0))) (\\PUTBASEBYTE XCL-USER::BASE 0 160) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (1 0 1 0)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-BIT (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (LET ((BYTE (\\GETBASEBYTE XCL-USER::BASE 0))) (LIST (LDB (BYTE 1 7) BYTE) (LDB (BYTE 1 6) BYTE) (LDB (BYTE 1 5) BYTE) (LDB (BYTE 1 4) BYTE))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-BYTE "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 8)" (CL:FLET ((XCL-USER::ARRAY-WRITE-BYTE (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 3 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 3))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 4)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-BYTE (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEBYTE XCL-USER::BASE XCL-USER::I)))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-WORD "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 16)" (CL:FLET ((XCL-USER::ARRAY-WRITE-WORD (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 4 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 4))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 65535)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-WORD (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASE XCL-USER::BASE XCL-USER::I)))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-SIGNED-WORD "Opcode ARRAYWRITE (MISC4 7), type (signed-byte 16)" (CL:FLET ((XCL-USER::ARRAY-WRITE-SIGNED-WORD (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 20 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 20))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 255 -32768)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-SIGNED-WORD (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (LET ((XCL-USER::WORD (\\GETBASE XCL-USER::BASE XCL-USER::I))) (CL:IF (> XCL-USER::WORD 32767) (\\VAG2 15 XCL-USER::WORD) XCL-USER::WORD))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FIXP "Opcode ARRAYWRITE (MISC4 7), type (signed-byte 32)" (CL:FLET ((XCL-USER::ARRAY-WRITE-FIXP (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 22 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 22))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 65536 -2147483648)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FIXP (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEFIXP XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FLOATP "Opcode ARRAYWRITE (MISC4 7), type single-float" (CL:FLET ((XCL-USER::ARRAY-WRITE-FLOATP (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 54 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 54))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0.0 -23.0 3.4456E+24 -4.562435E-12)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FLOATP (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEFLOATP XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-THIN-CHAR "Opcode ARRAYWRITE (MISC4 7), type thin-string-char" (CL:FLET ((XCL-USER::ARRAY-WRITE-THIN-CHAR (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 67 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 67))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-THIN-CHAR (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:CODE-CHAR (\\GETBASEBYTE XCL-USER::BASE XCL-USER::I))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FAT-CHAR "Opcode ARRAYWRITE (MISC4 7), type fat-string-char" (CL:FLET ((XCL-USER::ARRAY-WRITE-FAT-CHAR (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 68 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 68))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FAT-CHAR (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:CODE-CHAR (\\GETBASE XCL-USER::BASE XCL-USER::I))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-POINTER "Opcode ARRAYWRITE (MISC4 7), type t" (CL:FLET ((XCL-USER::ARRAY-WRITE-POINTER (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 38 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 38))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (LIST 2 #\c (QUOTE XCL-USER::A) (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-POINTER (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CONS (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1)) (\\REFCNT (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-XPOINTER "Opcode ARRAYWRITE (MISC4 7), type il:xpointer" (CL:FLET ((XCL-USER::ARRAY-WRITE-XPOINTER (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 86 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 86))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (LIST 2 #\c (QUOTE XCL-USER::A) (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-XPOINTER (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CONS (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1)) (\\REFCNT (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))))
-
-
-
-(* |;;| "Boxed opcodes")

-
-
-(RPAQQ *NON-CONSTANT-T* T)
-
-(RPAQQ *NON-CONSTANT-0* 0)
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT+ "Opcodes IPLUS,FPLUS, and PLUS, both args integer" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1 -3 9834756987354 21845 -54))) (CL:DOLIST (XCL-USER::Y (QUOTE (1 -3 9834756987354 21845 -54))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT+ "Opcodes IPLUS,FPLUS, and PLUS, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 -3.0 -3.4028235E+38 21845.0 -54.0))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED+ "Opcodes IPLUS,FPLUS, and PLUS, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 -3 1/3 9834756987354 21845 -54))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(DEFTESTGROUP ERROR+ (DO-TEST T-FIRST (EXPECT-ERRORS (T) (+ *NON-CONSTANT-T* 3))) (DO-TEST T-SECOND (EXPECT-ERRORS (T) (+ 3 *NON-CONSTANT-T*))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 3 9834756987354 21845 -54))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 3.0 3.4028235E+38 21845.0 -54.0))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 3 1/3 9834756987354 21845 -54))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT* "Opcodes ITIMES,FTIMES, and TIMES, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45 345235424 0 23 21845))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT* "Opcodes ITIMES,FTIMES, and TIMES, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45.0 0.0 1.1342745E+38 -21845.0))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED* "Opcodes ITIMES,FTIMES, and TIMES, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45 1/3 345235424 0 23 21845))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args integer" (LET ((XCL-USER::X 21845)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1 345235424 -45))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args float" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, args mixed" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1 4/3 -1345619432 45))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(DEFTESTGROUP ERROR/T (DO-TEST T-DIVISOR (EXPECT-ERRORS (T) (/ 34 *NON-CONSTANT-T*))) (DO-TEST T-NUMERATOR (EXPECT-ERRORS (T) (/ *NON-CONSTANT-T* 34))))
-
-(DEFTEST ERROR/0 (EXPECT-ERRORS (T) (/ 34 *NON-CONSTANT-0*)))
-
-(DEFTEST NO-ERROR-0/0 (/ *NON-CONSTANT-0* *NON-CONSTANT-0*))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 -45 345235424 22000))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 22000.0))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1/3 -45 5498457654 22000))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-
-
-(* |;;| "Unboxed opcodes [scalar]")

-
-
-
-
-(* |;;| "Ubfloat1")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::BOX "Opcode BOX (UBFLOAT1 0)" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE ((16256 . 0) (0 . 0) (49716 . 0) (26309 . 45156)))) (XCL:COLLECT (\\FLOATBOX (\\VAG2 (CAR XCL-USER::X) (CDR XCL-USER::X)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UNBOX "Opcode UNBOX (UBFLOAT1 1)" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1.0 0.0 -45.0 4.6678E+23))) (LET ((XCL-USER::Y (\\FLOATUNBOX XCL-USER::X))) (XCL:COLLECT (CONS (\\HILOC XCL-USER::Y) (\\LOLOC XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBABS "Opcode UFABS (UBFLOAT1 2)" (CL:FLET ((XCL-USER::UBABS (XCL-USER::X) (\\FLOATBOX ((OPCODES UBFLOAT1 2) (\\FLOATUNBOX XCL-USER::X))))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBABS XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBNEGATE "Opcode UFNEGATE (UBFLOAT1 3)" (CL:FLET ((XCL-USER::UBNEGATE (XCL-USER::X) (\\FLOATBOX ((OPCODES UBFLOAT1 3) (\\FLOATUNBOX XCL-USER::X))))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBNEGATE XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBFIX "Opcode UFIX (UBFLOAT1 4)" (CL:FLET ((XCL-USER::UBFIX (XCL-USER::X) ((OPCODES UBFLOAT1 4) (\\FLOATUNBOX XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBFIX XCL-USER::X))))))
-
-
-
-(* |;;| "Ubfloat2")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB+ "Opcode UFADD (UBFLOAT2 0)" (CL:FLET ((XCL-USER::UB+ (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 0) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 -3.0 -3.4028235E+38 21845.0 3))) (XCL:COLLECT (XCL-USER::UB+ XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB- "Opcode UFSUB (UBFLOAT2 1)" (CL:FLET ((XCL-USER::UB- (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((* |;;| "ub -") (OPCODES UBFLOAT2 1) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 3.0 3.4028235E+38 21845 1/3 -54.0))) (XCL:COLLECT (XCL-USER::UB- XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB* "Opcode UFMULT (UBFLOAT2 3)" (CL:FLET ((XCL-USER::UB* (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 3) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45.0 0.0 1.1342745E+38 -21845.0))) (XCL:COLLECT (XCL-USER::UB* XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB/ "Opcode UFDIV (UBFLOAT2 4)" (CL:FLET ((XCL-USER::UB/ (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 4) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (0.001 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (XCL:COLLECT (XCL-USER::UB/ XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB> "Opcode UFGREAT (UBFLOAT2 5)" (CL:FLET ((XCL-USER::UB> (XCL-USER::X XCL-USER::Y) ((OPCODES UBFLOAT2 5) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y)))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UB> XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBMAX "Opcode UFMAX (UBFLOAT2 6)" (CL:FLET ((XCL-USER::UBMAX (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 6) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UBMAX XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBMIN "Opcode UFMAX (UBFLOAT2 7)" (CL:FLET ((XCL-USER::UBMIN (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 7) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UBMIN XCL-USER::X XCL-USER::Y)))))))
-
-
-
-(* |;;| "Ubfloat3")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::POLY "Opcode POLY (UBFLOAT3 0)" (CL:FLET ((XCL-USER::POLY (XCL-USER::X XCL-USER::BASE XCL-USER::SIZE) (\\FLOATBOX ((OPCODES UBFLOAT3 0) (\\FLOATUNBOX XCL-USER::X) XCL-USER::BASE XCL-USER::SIZE)))) (LET* ((CL:ARRAY (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:SINGLE-FLOAT) :INITIAL-CONTENTS (QUOTE (1.0 2.0 3.0 4.0)))) (XCL-USER::BASE (%ARRAY-BASE CL:ARRAY))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::PAIR (QUOTE ((1.0 . 3) (1.0 . 1) (3.5 . 3)))) (XCL:COLLECT (XCL-USER::POLY (CAR XCL-USER::PAIR) XCL-USER::BASE (CDR XCL-USER::PAIR))))))))
-
-
-
-(* |;;| "Transcendentals --- stress test")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::SIN-TEST "Function SIN" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (0.0 1/3 -1.2 12.6))) (XCL:COLLECT (CL:SIN (CL:* CL:PI XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::COS-TEST "Function COS" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (0.0 1/3 -1.2 12.6))) (XCL:COLLECT (CL:COS (CL:* CL:PI XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::EXP-TEST "Function EXP" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1.0 20.5 1/3 -5.2))) (XCL:COLLECT (CL:EXP XCL-USER::X)))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::LOG-TEST "Function LOG" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (2.7182817 -2.0 453.78))) (XCL:COLLECT (CL:LOG XCL-USER::X)))))
-(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
-
-(ADDTOVAR NLAMA)
-
-(ADDTOVAR NLAML)
-
-(ADDTOVAR LAMA DORESTLISTTEST DOFINDKEYTEST)
-)
-(PUTPROPS OPCODES.TEST COPYRIGHT ("ENVOS Corporation" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (11351 11576 (ADDR-IN-RANGE 11361 . 11574)) (13705 20488 (UNWINDTESTER 13715 . 14136) (
-UNWINDMAINTEST 14138 . 17146) (UNWINDMAINTEST.RECURSE 17148 . 17317) (UNWINDCHECK1 17319 . 17617) (
-UNWINDCHECK2 17619 . 20284) (UNWINDCODE 20286 . 20486)) (20889 24148 (UW2.TEST 20899 . 21330) (
-UW2.RECURSE 21332 . 21571) (UW2.TEST.MAIN 21573 . 22230) (UW2.CHECK 22232 . 23840) (UW2.IDENTITY 23842
- . 24146)) (24314 25919 (FINDKEYTESTER 24324 . 24538) (DOFINDKEYTEST 24540 . 25420) (DOFINDKEYTEST1 
-25422 . 25917)) (26209 30598 (\\RESTLIST.SPLICE.FRAME 26219 . 27553) (RESTLISTTESTER 27555 . 28129) (
-DORESTLISTTEST 28131 . 28500) (GETRESTARGREFCNTS 28502 . 28723) (DORESTLISTTEST1 28725 . 30596)) (
-31186 36602 (CLOSURETESTER 31196 . 31498) (CLOSUREMAINTEST 31500 . 33501) (CLOSUREMAINTEST.RECURSE 
-33503 . 33659) (CLOSUREFNCHECK 33661 . 34464) (CLOSUREFNCHECK2 34466 . 34760) (CLOSUREFN1 34762 . 
-35251) (CLOSUREFN1VALUE 35253 . 35400) (CLOSUREFN2 35402 . 35891) (CLOSUREFN2VALUE 35893 . 36040) (
-CLOSUREFN4CODE 36042 . 36456) (CLOSUREFN4VALUE 36458 . 36600)) (36867 38501 (FVARTEST0 36877 . 37084) 
-(FVARTEST1 37086 . 37590) (FVARTEST2 37592 . 38278) (FVARTEST3 38280 . 38499)))))
-STOP

internal/test/Maiko/AUTO/OPCODES.TEST.~6~

@@ -1,823 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "16-Nov-88 16:38:34" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;9
 69113  
-
-      |changes| |to:|  (FUNCTIONS SLOPED-LINES DIAGONALS SIMULATE-PILOTBITBLT BUMP XCL-USER::COPY.N.TEST XCL-USER::STORE.N.TEST XCL-USER::POP.N.TEST)
- (XCL-USER::VERIFIED-TESTS XCL-USER::AREF1-POINTER XCL-USER::AREF1-XPOINTER) (TESTS ERROR+ ERROR/T ERROR/0 NO-ERROR-0/0)
- (VARS OPCODESCOMS) (FNS ADDR-IN-RANGE)
-
-      |previous| |date:| " 8-Nov-88 17:10:36" {ERIS}<TEST>MAIKO>AUTO>OPCODES.TEST\;7)
-
-
-; Copyright (c) 1988 by ENVOS Corporation.  All rights reserved.
-
-(PRETTYCOMPRINT OPCODESCOMS)
-
-(RPAQQ OPCODESCOMS ((* |;;| "This file contains tests for the various opcodes used in the system.") (VARS (*TEST-FILE-NAME* "OPCODES")) (COMS (* \; "BITBLT") (FUNCTIONS SIMULATE-PILOTBITBLT BUMP) (FUNCTIONS SLOPED-LINES DIAGONALS) (FNS ADDR-IN-RANGE) (TESTS BITBLT-DIAGONALS BITBLT-SLOPED-LINES)) (COMS (* \; "COPY.N") (FUNCTIONS XCL-USER::COPY.N.TEST) (TESTS COPY.N COPY.N-UFN)) (COMS (* \; "STORE.N") (FUNCTIONS XCL-USER::STORE.N.TEST) (TESTS STORE.N STORE.N-UFN)) (COMS (* \; "POP.N") (FUNCTIONS XCL-USER::POP.N.TEST) (TESTS POP.N POP.N-UFN)) (COMS (* \; "UNWIND") (TESTS UNWIND-OFF-BY-1-A UNWIND-OFF-BY-1-B) (FNS UNWINDTESTER UNWINDMAINTEST UNWINDMAINTEST.RECURSE UNWINDCHECK1 UNWINDCHECK2 UNWINDCODE) (DECLARE\: EVAL@COMPILE DONTCOPY (RECORDS BINDMARKSLOT)) (FNS UW2.TEST UW2.RECURSE UW2.TEST.MAIN UW2.CHECK UW2.IDENTITY) (TESTS UNWIND UNWIND-2)) (COMS (* \; "FINDKEY") (FNS FINDKEYTESTER DOFINDKEYTEST DOFINDKEYTEST1) (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS FINDKEYCHECK)) (TESTS FINDKEY)) (COMS (* \; "RESTLIST") (FNS \\RESTLIST.SPLICE.FRAME RESTLISTTESTER DORESTLISTTEST GETRESTARGREFCNTS DORESTLISTTEST1) (INITVARS (RESTLISTCOUNTER 0)) (DECLARE\: EVAL@COMPILE DONTCOPY (MACROS RESTLISTCHECK \\COMPUTED.FORM) (RECORDS MDSTYPEWORD) (GLOBALVARS RESTLISTCOUNTER)) (TESTS RESTLIST)) (COMS (* \; "Closure tests") (FNS CLOSURETESTER CLOSUREMAINTEST CLOSUREMAINTEST.RECURSE CLOSUREFNCHECK CLOSUREFNCHECK2 CLOSUREFN1 CLOSUREFN1VALUE CLOSUREFN2 CLOSUREFN2VALUE CLOSUREFN4CODE CLOSUREFN4VALUE) (INITVARS (CLOSURETEST.DEPTH 50) (CLOSURETEST.ENVIRONMENT "Closure Environment")) (GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT) (TESTS CLOSURES)) (COMS (* \; "Free-variable lookup") (FNS FVARTEST0 FVARTEST1 FVARTEST2 FVARTEST3) (TESTS FREE-VAR-LOOKUP)) (COMS (* \; "AREF opcode tests") (VARS (*NON-CONSTANT-FLOAT-1* 1.0)) (XCL-USER::VERIFIED-TESTS XCL-USER::AREF1-BIT XCL-USER::AREF1-BYTE XCL-USER::AREF1-WORD XCL-USER::AREF1-SIGNED-WORD XCL-USER::AREF1-FIXP XCL-USER::AREF1-FLOATP XCL-USER::AREF1-STRING-CHAR XCL-USER::AREF1-POINTER XCL-USER::AREF1-XPOINTER XCL-USER::AREF1-PUNT) (* |;;| "array-read and array-write ") (XCL-USER::VERIFIED-TESTS XCL-USER::ARRAY-READ-BIT XCL-USER::ARRAY-READ-BYTE XCL-USER::ARRAY-READ-WORD XCL-USER::ARRAY-READ-SIGNED-WORD XCL-USER::ARRAY-READ-FIXP XCL-USER::ARRAY-READ-FLOATP XCL-USER::ARRAY-READ-THIN-CHAR XCL-USER::ARRAY-READ-FAT-CHAR XCL-USER::ARRAY-READ-POINTER XCL-USER::ARRAY-READ-XPOINTER) (XCL-USER::VERIFIED-TESTS XCL-USER::ARRAY-WRITE-BIT XCL-USER::ARRAY-WRITE-BYTE XCL-USER::ARRAY-WRITE-WORD XCL-USER::ARRAY-WRITE-SIGNED-WORD XCL-USER::ARRAY-WRITE-FIXP XCL-USER::ARRAY-WRITE-FLOATP XCL-USER::ARRAY-WRITE-THIN-CHAR XCL-USER::ARRAY-WRITE-FAT-CHAR XCL-USER::ARRAY-WRITE-POINTER XCL-USER::ARRAY-WRITE-XPOINTER)) (COMS (* |;;| "Boxed opcodes") (VARS (*NON-CONSTANT-T* T) (*NON-CONSTANT-0* 0)) (XCL-USER::VERIFIED-TESTS XCL-USER::INT+ XCL-USER::FLOAT+ XCL-USER::MIXED+) (TESTS ERROR+) (XCL-USER::VERIFIED-TESTS XCL-USER::INT- XCL-USER::FLOAT- XCL-USER::MIXED-) (XCL-USER::VERIFIED-TESTS XCL-USER::INT* XCL-USER::FLOAT* XCL-USER::MIXED*) (XCL-USER::VERIFIED-TESTS XCL-USER::INT/ XCL-USER::FLOAT/ XCL-USER::MIXED/) (TESTS ERROR/T ERROR/0 NO-ERROR-0/0) (XCL-USER::VERIFIED-TESTS XCL-USER::INT> XCL-USER::FLOAT> XCL-USER::MIXED>)) (COMS (* |;;| "Unboxed opcodes [scalar]") (* |;;| "Ubfloat1") (XCL-USER::VERIFIED-TESTS XCL-USER::BOX XCL-USER::UNBOX XCL-USER::UBABS XCL-USER::UBNEGATE XCL-USER::UBFIX) (* |;;| "Ubfloat2") (XCL-USER::VERIFIED-TESTS XCL-USER::UB+ XCL-USER::UB- XCL-USER::UB* XCL-USER::UB/ XCL-USER::UB> XCL-USER::UBMAX XCL-USER::UBMIN) (* |;;| "Ubfloat3") (XCL-USER::VERIFIED-TESTS XCL-USER::POLY)) (COMS (* |;;| "Transcendentals --- stress test") (XCL-USER::VERIFIED-TESTS XCL-USER::SIN-TEST XCL-USER::COS-TEST XCL-USER::EXP-TEST XCL-USER::LOG-TEST)) (DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA DORESTLISTTEST DOFINDKEYTEST)))))
-
-
-
-(* |;;| "This file contains tests for the various opcodes used in the system.")

-
-
-(RPAQ *TEST-FILE-NAME* "OPCODES")
-
-
-
-(* \; "BITBLT")

-
-
-(CL:DEFUN SIMULATE-PILOTBITBLT (BBT LOW-WORD-ADDR HI-WORD-ADDR) (* |;;| "A translation of the algorithm in the Mesa PrincOps.") (* |;;| " S-L-O-W !!!") (LET ((SRC.WORD (FETCH (PILOTBBT PBTSOURCE) OF BBT)) (SRC.BIT (FETCH (PILOTBBT PBTSOURCEBIT) OF BBT)) (SRC.BPL (FETCH (PILOTBBT PBTSOURCEBPL) OF BBT)) (DST.WORD (FETCH (PILOTBBT PBTDEST) OF BBT)) (DST.BIT (FETCH (PILOTBBT PBTDESTBIT) OF BBT)) (DST.BPL (FETCH (PILOTBBT PBTDESTBPL) OF BBT)) (BBT.WIDTH (FETCH (PILOTBBT PBTWIDTH) OF BBT)) (BBT.HEIGHT (FETCH (PILOTBBT PBTHEIGHT) OF BBT)) (BOOL-OP (LET ((COMPLEMENT? (NOT (CL:ZEROP (FETCH (PILOTBBT PBTSOURCETYPE) OF BBT))))) (CL:ECASE (FETCH (PILOTBBT PBTOPERATION) OF BBT) ((0) (CL:IF COMPLEMENT? CL:BOOLE-C1 CL:BOOLE-1)) ((1) (CL:IF COMPLEMENT? CL:BOOLE-ANDC1 CL:BOOLE-AND)) ((2) (CL:IF COMPLEMENT? CL:BOOLE-ORC1 CL:BOOLE-IOR)) ((3) (CL:IF COMPLEMENT? CL:BOOLE-EQV CL:BOOLE-XOR))))) (GRAY? (FETCH (PILOTBBT PBTUSEGRAY) OF BBT)) (GRAY.WIDTH (ITIMES (ADD1 (FETCH (PILOTBBT PBTGRAYWIDTHLESSONE) OF BBT)) 16)) (GRAY.HEIGHT (ADD1 (FETCH (PILOTBBT PBTGRAYHEIGHTLESSONE) OF BBT))) LINE GRAY.BUMP LAST-GRAY Y-FORWARD? X-FORWARD?) (CL:LABELS ((MODIFY-BIT (DSTWORD DSTBIT DSTOFFSET SRCWORD SRCBIT SRCOFFSET) (CL:MULTIPLE-VALUE-BIND (SRCWORD SRCBIT) (BUMP SRCWORD SRCBIT SRCOFFSET) (CL:MULTIPLE-VALUE-BIND (DSTWORD DSTBIT) (BUMP DSTWORD DSTBIT DSTOFFSET) (ADDR-IN-RANGE LOW-WORD-ADDR DSTWORD HI-WORD-ADDR) (CL:SETF (LDB (BYTE 1 (IDIFFERENCE 15 DSTBIT)) (GETBASE DSTWORD 0)) (CL:BOOLE BOOL-OP (LDB (BYTE 1 (IDIFFERENCE 15 SRCBIT)) (GETBASE SRCWORD 0)) (LDB (BYTE 1 (IDIFFERENCE 15 DSTBIT)) (GETBASE DSTWORD 0))))))) (BITBLT-ITEM NIL (LET ((OFFSET (CL:IF X-FORWARD? 0 (SUB1 BBT.WIDTH)))) (FRPTQ BBT.WIDTH (LET ((POS (CL:IF GRAY? (IDIFFERENCE (IMOD (IPLUS OFFSET SRC.BIT) (ABS GRAY.WIDTH)) SRC.BIT) OFFSET))) (MODIFY-BIT DST.WORD DST.BIT OFFSET SRC.WORD SRC.BIT POS)) (CL:INCF OFFSET (CL:IF X-FORWARD? 1 -1))))) (SETUP NIL (CL:WHEN GRAY? (SETQ GRAY.BUMP (IMINUS (ITIMES GRAY.WIDTH (SUB1 GRAY.HEIGHT))))) (COMPUTE-DIRECTION) (CL:WHEN GRAY? (SETQ LAST-GRAY (CL:IF Y-FORWARD? (IDIFFERENCE GRAY.HEIGHT 1 (FETCH (PILOTBBT PBTGRAYOFFSET) OF BBT)) (FETCH (PILOTBBT PBTGRAYOFFSET) OF BBT)))) (SETQ LINE (CL:IF Y-FORWARD? 0 (SUB1 BBT.HEIGHT)))) (COMPUTE-DIRECTION NIL (SETQ Y-FORWARD? (SETQ X-FORWARD? (NOT (FETCH (PILOTBBT PBTBACKWARD) OF BBT)))))) (SETUP) (WHILE (AND (ILEQ 0 LINE) (ILESSP LINE BBT.HEIGHT)) DO (BITBLT-ITEM) (BLOCK) (* \; "just to be nice.") (CL:MULTIPLE-VALUE-SETQ (SRC.WORD SRC.BIT) (BUMP SRC.WORD SRC.BIT (CL:IF GRAY? (CL:IF (= (IMOD LINE GRAY.HEIGHT) LAST-GRAY) GRAY.BUMP GRAY.WIDTH) SRC.BPL))) (CL:MULTIPLE-VALUE-SETQ (DST.WORD DST.BIT) (BUMP DST.WORD DST.BIT DST.BPL)) (CL:INCF LINE (CL:IF Y-FORWARD? 1 -1))))))
-
-(CL:DEFUN BUMP (WORD BIT INCR) (CL:MULTIPLE-VALUE-BIND (WORD-INCR NEW-BIT) (CL:FLOOR (IPLUS BIT INCR) 16) (CL:VALUES (ADDBASE WORD WORD-INCR) NEW-BIT)))
-
-(CL:DEFUN SLOPED-LINES (W) (LET* ((FEEDBACK-INTERVAL (QUOTIENT W 20)) (NEXT-FEEDBACK 0) (BLACK #16*1) (A (CL:MAKE-ARRAY (LIST W W) :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) (DA (CL:MAKE-ARRAY (ITIMES W W) :ELEMENT-TYPE (QUOTE BIT) :DISPLACED-TO A)) (R (CL:MAKE-ARRAY (LIST W W) :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) (LOW-ADDR (FETCH (ARRAY-HEADER BASE) OF R)) (HI-ADDR (\\ADDBASE LOW-ADDR (SUB1 (IQUOTIENT (+ 15 (ITIMES W W)) 16)))) (DR (CL:MAKE-ARRAY (ITIMES W W) :ELEMENT-TYPE (QUOTE BIT) :DISPLACED-TO R)) (BBT (CREATE PILOTBBT PBTDEST _ (FETCH (ARRAY-HEADER BASE) OF A) PBTDESTBIT _ 0 PBTSOURCE _ (FETCH (ARRAY-HEADER BASE) OF BLACK) PBTSOURCEBIT _ 0 PBTGRAYOFFSET _ 0 PBTGRAYWIDTHLESSONE _ 0 PBTGRAYHEIGHTLESSONE _ 0 PBTWIDTH _ 0 PBTDISJOINT _ T PBTUSEGRAY _ T))) (CL:DOTIMES (SLOPE W) (CL:WHEN (> SLOPE NEXT-FEEDBACK) (CL:PRINC #\. *ERROR-OUTPUT*) (CL:INCF NEXT-FEEDBACK FEEDBACK-INTERVAL)) (CL:FILL DA 0) (REPLACE (PILOTBBT PBTDESTBPL) OF BBT WITH (IPLUS W SLOPE 1)) (CL:INCF (FETCH (PILOTBBT PBTWIDTH) OF BBT)) (REPLACE (PILOTBBT PBTHEIGHT) OF BBT WITH (CL:CEILING W (ADD1 SLOPE))) (\\PILOTBITBLT BBT NIL) (CL:FILL DR 0) (SIMULATE-PILOTBITBLT (CREATE PILOTBBT USING BBT PBTDEST _ (FETCH (ARRAY-HEADER BASE) OF R)) LOW-ADDR HI-ADDR) (CL:WHEN (NOT (CL:EQUAL DA DR)) (CL:CERROR "Try the next one" "Bad BITBLT: diagonal w: ~D slope: ~D" W SLOPE)))))
-
-(CL:DEFUN DIAGONALS (W SKIP-SIMULATION SKIP-UCODE) (* |;;| "Draw both diagonals in a square of size W.") (* |;;| "if SKIP-SIMULATION is not NIL, don't bother with the simulation or a consistency check.") (* |;;| "if SKIP-UCODE is not NIL, don't bother with the real microcode version or a consistency check.") (LET* ((FAILURES NIL) (BLACK #16*1) (A (CL:MAKE-ARRAY (LIST W W) :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) (A-BASE (FETCH (ARRAY-HEADER BASE) OF A)) (DA (CL:MAKE-ARRAY (ITIMES W W) :ELEMENT-TYPE (QUOTE BIT) :DISPLACED-TO A)) (R (CL:MAKE-ARRAY (LIST W W) :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0)) (R-BASE (FETCH (ARRAY-HEADER BASE) OF R)) (LOW-ADDR R-BASE) (HI-ADDR (\\ADDBASE LOW-ADDR (SUB1 (IQUOTIENT (+ 15 (ITIMES W W)) 16)))) (DR (CL:MAKE-ARRAY (ITIMES W W) :ELEMENT-TYPE (QUOTE BIT) :DISPLACED-TO R)) (BBT (CREATE PILOTBBT PBTSOURCE _ (FETCH (ARRAY-HEADER BASE) OF BLACK) PBTSOURCEBIT _ 0 PBTGRAYOFFSET _ 0 PBTGRAYWIDTHLESSONE _ 0 PBTGRAYHEIGHTLESSONE _ 0 PBTWIDTH _ 1 PBTHEIGHT _ W PBTDISJOINT _ T PBTUSEGRAY _ T))) (CL:MACROLET ((CLEAR (WHICH) (BQUOTE (CL:FILL (\\\, WHICH) 0)))) (CL:LABELS ((SET-SOURCE (BBT BASE INCREMENT) (CL:MULTIPLE-VALUE-BIND (WORD BIT) (BUMP BASE 0 INCREMENT) (REPLACE (PILOTBBT PBTDEST) OF BBT WITH WORD) (REPLACE (PILOTBBT PBTDESTBIT) OF BBT WITH BIT)) BBT) (CHECK-RESULT (FROM TO START-OFFSET) (CLEAR DR) (CL:UNLESS SKIP-SIMULATION (* |;;| "Only run this if we need the simulation.") (SIMULATE-PILOTBITBLT (SET-SOURCE (CREATE PILOTBBT USING BBT) R-BASE START-OFFSET) LOW-ADDR HI-ADDR)) (CL:UNLESS (OR SKIP-SIMULATION SKIP-UCODE) (* |;;| "Only check the results if we ran both versions.") (CL:WHEN (NOT (CL:EQUAL DA DR)) (CL:PUSH (CL:CONCATENATE (QUOTE STRING) FROM " to " TO) FAILURES) (CL:CERROR "Try the next one" "Bad BITBLT: ~A to ~A diagonal w: ~D " FROM TO W)))) (DO-ONE (FROM TO START-OFFSET BPL) (CLEAR DA) (REPLACE (PILOTBBT PBTDESTBPL) OF BBT WITH BPL) (REPLACE (PILOTBBT PBTBACKWARD) OF BBT WITH (ILESSP BPL 0)) (OR SKIP-UCODE (\\PILOTBITBLT (SET-SOURCE BBT A-BASE START-OFFSET) NIL)) (CHECK-RESULT FROM TO START-OFFSET))) (DO-ONE "upper left" "lower right" 0 (ADD1 W)) (DO-ONE "upper right" "lower left" (SUB1 W) (SUB1 W)) (DO-ONE "lower left" "upper right" (ITIMES W (SUB1 W)) (IMINUS (SUB1 W))) (DO-ONE "lower right" "upper left" (SUB1 (ITIMES W W)) (IMINUS (ADD1 W))))) (CL:VALUES (NOT FAILURES) FAILURES)))
-(DEFINEQ
-
-(ADDR-IN-RANGE

-(LAMBDA (LOW ADDR HI) (* \; "Edited 16-Nov-88 14:32 by jds") (OR (<= (+ (LLSH (HILOC LOW) 16) (LOLOC LOW)) (+ (LLSH (HILOC ADDR) 16) (LOLOC ADDR)) (+ (LLSH (HILOC HI) 16) (LOLOC HI))) (HELP)))
-)
-)
-
-(DEFTEST (BITBLT-DIAGONALS :COMPILED) (FOR WIDTH IN (QUOTE (1 2 3 4 5 7 8 9 15 16 17 31 32 33 39 40 41)) ALWAYS (PRINT WIDTH) (* \; "DD") (DIAGONALS WIDTH)))
-
-(DEFTEST (BITBLT-SLOPED-LINES :COMPILED) (FOR I IN (QUOTE (1 3 4 5 7 8 9 15 16 17)) DO (SLOPED-LINES I)) T)
-
-
-
-(* \; "COPY.N")

-
-
-(CL:DEFUN XCL-USER::COPY.N.TEST (XCL-USER::USE-UFN) "Tests a case of the COPY.N opcode. Both (COPY.N.TEST NIL) and (COPY.N.TEST T) should return :OK" (CL:IF XCL-USER::USE-UFN (PROGN ((OPCODES COPY) 2 1 :OK -1 -2) (CL:FUNCALL (\\GETUFNENTRY (QUOTE COPY.N)) 4)) ((OPCODES COPY.N 4) 2 1 :OK -1 -2)))
-
-(DEFTEST (COPY.N :COMPILED) (* |;;| "COPY.N  opcode") (EQ :OK (XCL-USER::COPY.N.TEST)))
-
-(DEFTEST COPY.N-UFN (EQ :OK (XCL-USER::COPY.N.TEST T)))
-
-
-
-(* \; "STORE.N")

-
-
-(CL:DEFUN XCL-USER::STORE.N.TEST (XCL-USER::USE-UFN) "Tests a case of the STORE.N opcode. Both (STORE.N.TEST NIL) and (STORE.N.TEST T) should return the list (5 4 t 2 1)" (CL:IF XCL-USER::USE-UFN (PROGN ((OPCODES COPY) 5 4 3 2 1) (CL:FUNCALL (\\GETUFNENTRY (QUOTE STORE.N)) T 4)) ((OPCODES STORE.N 4) 5 4 3 2 1 T)) ((OPCODES APPLYFN) 5 (QUOTE LIST)))
-
-(DEFTEST (STORE.N :COMPILED) (* |;;| "COPY.N  opcode") (EQUAL (QUOTE (5 4 T 2 1)) (XCL-USER::STORE.N.TEST)))
-
-(DEFTEST STORE.N-UFN (* |;;| "STORE.N  opcode") (EQUAL (QUOTE (5 4 T 2 1)) (XCL-USER::STORE.N.TEST T)))
-
-
-
-(* \; "POP.N")

-
-
-(CL:DEFUN XCL-USER::POP.N.TEST (XCL-USER::USE-UFN) "Tests a case of the STORE.N opcode. Both (POP.N.TEST NIL) and (POP.N.TEST T) should return 2" (CL:IF XCL-USER::USE-UFN (PROGN ((OPCODES COPY) 4 3 2 1 0) (CL:FUNCALL (\\GETUFNENTRY (QUOTE POP.N)) 2)) ((OPCODES POP.N 2) 4 3 2 1 0)))
-
-(DEFTEST (POP.N :COMPILED) (= 3 (XCL-USER::POP.N.TEST)))
-
-(DEFTEST POP.N-UFN (= 3 (XCL-USER::POP.N.TEST T)))
-
-
-
-(* \; "UNWIND")

-
-
-(DEFTEST UNWIND-OFF-BY-1-A (LET ((F CL:PI)) (EQUAL (LIST (QUOTE SUCCESS) (PROGN (|for| C |in| (UNPACK F) |do| (PRIN1 C)) F)) (QUOTE (SUCCESS 3.1415927)))))
-
-(DEFTEST UNWIND-OFF-BY-1-B (* |;;| "Make sure that UNWIND doesn't mung the binding for F during the for loop.") (LET ((F CL:PI)) (|for| C |in| (UNPACK F) |do| (PRIN1 C)) (AND (FLOATP F) (= F CL:PI))))
-(DEFINEQ
-
-(UNWINDTESTER

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 26-Sep-88 14:11 by bvm")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH)
-       |do|
 (LET ((VALUE (UNWINDMAINTEST
 D (LOGAND D 7))))
-                     (COND
-                        ((NEQ VALUE 'SUCCESS)
-                         (HELP "UNWINDMAINTEST did not return correctly" VALUE)))))
-    T))
-
-(UNWINDMAINTEST

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:10 by bvm")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET ((*B* 3)
-              (*C* 2)
-              (*D* DEPTH))
-             (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-             (LIST (UNWINDCHECK1
 DEPTH)
-                   (LET ((*E* 10)
-                         (*F* 11)
-                         (*G* 12)
-                         (*H* DEPTH))
-                        (DECLARE
 (CL:SPECIAL *E* *F* *G* *H*))
-
-                        (* |;;| "There are 8 pvar slots in this frame (for 7 pvars), so empty stack = 8+2 = 10.  Right now the stack depth is up to 13, because of two bind marks and the value returned from UNWINDCHECK1.")

-
-                        (UNWINDCHECKFAIL T *B* *C* *D* *E* *F* 'PREVPREV 'PREVIOUS-VALUE
-                               (PROGN                        (* \; 
-
                            "Unwind stack to depth 10 + {0,1,3,6} preserving tos when code is even")

-                                      (SELECTQ CODE
-                                          (0                 (* \; "Blow away whole stack")

-                                             ((OPCODES UNWIND 10 0)))
-                                          (1                 (* \; "Same as 0 but keep tos")

-                                             ((OPCODES UNWIND 10 1)))
-                                          (2                 (* \; "Blow away second binding only")

-                                             ((OPCODES UNWIND 11 0)))
-                                          (3                 (* \; "Same as 2 but keep tos")

-                                             ((OPCODES UNWIND 11 1)))
-                                          (4                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 13 0)))
-                                          (5                 (* \; "Same as 4 but keep tos")

-                                             ((OPCODES UNWIND 13 1)))
-                                          (6                 (* \; 
-
                                     "Don't touch the bindings, just get rid of some dynamic stuff")

-                                             ((OPCODES UNWIND 16 0)))
-                                          ((OPCODES UNWIND 16 1))))
-                               (PROGN                        (* \; 
-
                                     "Check that previous opcode left the stack in the right state")

-                                      (UNWINDCHECK2
 CODE)))))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UNWINDMAINTEST.RECURSE
 (SUB1 DEPTH)
-                 CODE)))))
-
-(UNWINDMAINTEST.RECURSE

-  (LAMBDA (DEPTH CODE)
                                   (* \; "Edited 26-Sep-88 14:08 by bvm")

-    (UNWINDMAINTEST
 DEPTH CODE)))
-
-(UNWINDCHECK1

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 13:15")

-                                                             (* \; 
-
                                                "This just prevents compiler from merging specials")

-    NIL))
-
-(UNWINDCHECK2

-  (LAMBDA (CODE)
                                         (* \; "Edited 26-Sep-88 14:10 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.  TOS should be PREVIOUS-VALUE if the UNWIND said to preserve TOS.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD (+ 10 (LOGAND CODE 1)
-                                  (SELECTQ (LRSH CODE 1)
-                                      (0 0)
-                                      (1 1)
-                                      (2 3)
-                                      6))
-                              WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT (UNWINDCODE
 CODE)
-                           " unwound stack "
-                           (COND
-                              ((GREATERP GOODEOS EOS)
-                               "too far")
-                              (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words")))
-             ((AND (ODDP CODE)
-                   (NEQ (\\GETBASEPTR (ADDSTACKBASE (IDIFFERENCE EOS WORDSPERCELL))
-                               0)
-                        'PREVIOUS-VALUE))                    (* \; "Should have preserved tos")

-              (HELP (UNWINDCODE
 CODE)
-                    " did not preserve top of stack")))
-          (|for|
 V |in|
 '(*B* *C* *D* *E* *F* *G* *H*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (SELECTQ (LRSH CODE 1)
-                                                 (0 T)
-                                                 (1 (FMEMB V '(*E* *F* *G* *H*)))
-                                                 NIL))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT (UNWINDCODE
 CODE)
-                                                         " left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT (UNWINDCODE
 CODE)
-                                    " left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from UNWINDMAINTEST because the UNWIND there has ruined its stack")

-
-                 (RETFROM 'UNWINDMAINTEST 'SUCCESS)))))
-
-(UNWINDCODE

-  (LAMBDA (CODE)
                                         (* |bvm:| "21-Jul-86 15:34")

-    (CONCAT "UNWIND." (PLUS 10 (LOGAND CODE 1))
-           "."
-           (LRSH CODE 1))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD BINDMARKSLOT
 ((BINDMARKP FLAG) (NIL BITS 15)) (BLOCKRECORD BINDMARKSLOT ((BINDNEGVALUES WORD) (BINDLASTPVAR WORD)))
- (ACCESSFNS BINDMARKSLOT ((BINDNVALUES (PROGN (* |Value| |stored| |in| |high| |half| |is| |one's| |complement| |of| |number| |of| |values| |bound|) (LOGXOR (|fetch| BINDNEGVALUES |of| DATUM) 65535)))))
-)
-)
-)
-(DEFINEQ
-
-(UW2.TEST

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 15:00 by vanmelle")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (UW2.TEST.MAIN
))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (UW2.RECURSE
 (SUB1 DEPTH))))))
-
-(UW2.RECURSE

-  (LAMBDA (DEPTH)
                                    (* \; "Edited 20-Oct-88 14:56 by vanmelle")

-                                                             (* \; "To foil compiler")

-    (UW2.TEST
 DEPTH)))
-
-(UW2.TEST.MAIN

-  (LAMBDA (DEPTH)
                                        (* \; "Edited 20-Oct-88 15:49 by bvm")

-    (LET ((*B* 3)
-          (*C* 2.4)
-          (*D* DEPTH))
-         (DECLARE
 (CL:SPECIAL *B* *C* *D*))
-         (LIST (UW2.IDENTITY
 'TOS)
-               (LET ((*E* 3.5))
-                    (DECLARE
 (CL:SPECIAL *E*))
-
-                    (* |;;| "There are 4 pvar slots in this frame, so empty stack = 4+2 = 6.  Right now the stack depth is up to 9, because of 2 bind marks and the value from NILL.")

-
-                    (UNWINDCHECKFAIL T NIL ((OPCODES UNWIND 9 0))
-                           (UW2.CHECK
)))))))
-
-(UW2.CHECK

-  (LAMBDA NIL
                                            (* \; "Edited 20-Oct-88 15:49 by bvm")

-
-(* |;;;| "Check that the UNWIND opcode executed prior to this did the right thing.")

-
-    (LET* ((CALLER (\\MYALINK))
-           (EOS (|fetch|
 (FX NEXTBLOCK) |of|
 CALLER))
-           (GOODEOS (+ (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER)
-                       (UNFOLD 9 WORDSPERCELL))))
-          (COND
-             ((NEQ EOS GOODEOS)
-              (HELP (CONCAT "Unwound stack " (COND
-                                                ((GREATERP GOODEOS EOS)
-                                                 "too far")
-                                                (T "not far enough"))
-                           " by "
-                           (ABS (DIFFERENCE EOS GOODEOS))
-                           " words"))))
-          (|for|
 V |in|
 '(*B* *C* *D* *E*) |bind|
 SHOULDBEUNBOUNDP
-             |do|
 (SETQ SHOULDBEUNBOUNDP (AND NIL (EQ V '*E*)))
-                   (COND
-                      ((\\FRAMESCAN CALLER (\\ATOMVALINDEX V))
-                       (COND
-                          (SHOULDBEUNBOUNDP (HELP (CONCAT "UNWIND left variable " V 
-                                                         " bound but shouldn't have")))))
-                      ((NOT SHOULDBEUNBOUNDP)
-                       (HELP (CONCAT "UNWIND left variable " V " unbound but shouldn't have")))))
-          (PROGN 
-                 (* |;;| "Escape from test because the UNWIND there has confused its stack")

-
-                 (RETFROM 'UW2.TEST.MAIN 'SUCCESS)))))
-
-(UW2.IDENTITY

-  (LAMBDA (X)
                                            (* \; "Edited 20-Oct-88 15:19 by bvm")

-                                                             (* \; 
-
                                                           "Identity compiler doesn't know about")

-    X))
-)
-
-(DEFTEST (UNWIND :COMPILED) (UNWINDTESTER))
-
-(DEFTEST (UNWIND-2 :COMPILED) (FOR I FROM 0 TO 100 ALWAYS (EQ (QUOTE SUCCESS) (UW2.TEST I))))
-
-
-
-(* \; "FINDKEY")

-
-(DEFINEQ
-
-(FINDKEYTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "14-Jul-86 17:54")

-
-(* |;;;| "Test the opcode FINDKEY")

-
-    (DOFINDKEYTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)))
-
-(DOFINDKEYTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (FINDKEYCHECK 1 ||)
-         (FINDKEYCHECK 2 ||)
-         (FINDKEYCHECK 3 ||)
-         (FINDKEYCHECK 4 ||)
-         (FINDKEYCHECK 5 ||)
-         (FINDKEYCHECK 6 ||)
-         (FINDKEYCHECK 7 ||)
-         (FINDKEYCHECK 8 ||)
-         (FINDKEYCHECK 1 KEYB)
-         (FINDKEYCHECK 2 KEYB)
-         (FINDKEYCHECK 3 KEYB)
-         (FINDKEYCHECK 4 KEYB)
-         (FINDKEYCHECK 5 KEYB)
-         (FINDKEYCHECK 6 KEYB)
-         (FINDKEYCHECK 7 KEYB)
-         (FINDKEYCHECK 8 KEYB)
-         (FINDKEYCHECK 1 KEYC)
-         (FINDKEYCHECK 2 KEYC)
-         (FINDKEYCHECK 3 KEYC)
-         (FINDKEYCHECK 4 KEYC)
-         (FINDKEYCHECK 5 KEYC)
-         (FINDKEYCHECK 6 KEYC)
-         (FINDKEYCHECK 7 KEYC)
-         (FINDKEYCHECK 8 KEYC))))
-
-(DOFINDKEYTEST1

-  (LAMBDA (RESULT N KEY)
                                 (* |bvm:| "21-Jul-86 16:37")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (LET ((ANSWER (|for|
 I |from|
 N |by|
 2 |to|
 KEYARGS
-                     |when|
 (EQ KEY (ARG KEYARGS I)) |do|
 (RETURN (ADD1 I)))))
-         (COND
-            ((NEQ ANSWER RESULT)
-             (HELP (CONCAT "FINDKEY." N " returned " RESULT " instead of " ANSWER " for ")
-                   KEY))
-            (T T)))))
-)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS FINDKEYCHECK DMACRO (DEFMACRO (N KEY) (BQUOTE (DOFINDKEYTEST1 ((OPCODES FINDKEY (\\\, N)) (QUOTE (\\\, KEY))) (\\\, N) (QUOTE (\\\, KEY))))))
-)
-)
-
-(DEFTEST (FINDKEY :COMPILED) (FINDKEYTESTER))
-
-
-
-(* \; "RESTLIST")

-
-(DEFINEQ
-
-(\\RESTLIST.SPLICE.FRAME

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:13")

-
-(* |;;;| "If caller is fast, so its BF is contiguous with its caller's FX, then adjust pointers so that its first ivar goes back on it's caller's fx, and back up pc")

-
-    (UNINTERRUPTABLY
-        (LET ((CALLER (\\MYALINK))
-              CALLER2 IVAR BF)
-             (COND
-                ((AND (|fetch|
 (FX FASTP) |of|
 CALLER)
-                      (EQ (SETQ IVAR (|fetch|
 (BF IVAR) |of|
 (SETQ BF (|fetch|

-                                                                               (FX DUMMYBF)
-                                                                                 |of|
 CALLER))))
-                          (|fetch|
 (FX NEXTBLOCK) |of|
 (SETQ CALLER2 (|fetch|

-                                                                              (FX ALINK) |of|

-                                                                                         CALLER)))))
-                 (|replace|
 (BF IVAR) |of|
 BF |with|
 (|add|
 IVAR WORDSPERCELL))
-                 (|replace|
 (FX NEXTBLOCK) |of|
 CALLER2 |with|
 IVAR)
-                 (|add|
 (|fetch|
 (FX PC) |of|
 CALLER2)
-                        -2)
-                 T))))))
-
-(RESTLISTTESTER

-  (LAMBDA NIL
                                            (* |bvm:| "21-Jul-86 17:28")

-
-(* |;;;| "Test the opcode RESTLIST")

-
-    (AND (DORESTLISTTEST
 '|| 'VALA 'KEYB 'VALB 'KEYC 'VALC)
-         (DORESTLISTTEST
 '(||)
-                '(VALA)
-                '(KEYB)
-                'VALB
-                '(KEYC)
-                '(VALC))
-         (DORESTLISTTEST
)
-         (\\COMPUTED.FORM (CONS 'DORESTLISTTEST (|for|
 I |from|
 1 |to|
 200
-                                                   |collect|
 `',(LIST I)))))))
-
-(DORESTLISTTEST

-  (LAMBDA KEYARGS
                                        (* |bvm:| "21-Jul-86 16:39")

-    (DECLARE
 (SPECVARS KEYARGS))
-    (AND (RESTLISTCHECK 1)
-         (RESTLISTCHECK 2)
-         (RESTLISTCHECK 3)
-         (RESTLISTCHECK 4)
-         (RESTLISTCHECK 5)
-         (RESTLISTCHECK 6)
-         (RESTLISTCHECK 7)
-         (RESTLISTCHECK 8))))
-
-(GETRESTARGREFCNTS

-  (LAMBDA (N)
-    (DECLARE
 (USEDFREE KEYARGS))
                     (* |bvm:| "18-Jul-86 15:01")

-    (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (\\REFCNT (ARG KEYARGS I)))))
-
-(DORESTLISTTEST1

-  (LAMBDA (REFCNTS RESULT N)
                             (* |bvm:| "21-Jul-86 17:22")

-    (DECLARE
 (USEDFREE KEYARGS))
-    (COND
-       ((OR (NOT (EQLENGTH RESULT (IMAX (IDIFFERENCE KEYARGS (SUB1 N))
-                                        0)))
-            (|for|
 R |in|
 RESULT |as|
 I |from|
 N |to|
 KEYARGS
-               |thereis|
 (NEQ R (ARG KEYARGS I))))
-        (HELP (CONCAT "RESTLIST." N " returned " RESULT " instead of "
-                     (|for|
 I |from|
 N |to|
 KEYARGS |collect|
 (ARG KEYARGS I))))))
-    (|for|
 TAIL |on|
 RESULT |as|
 CNT |in|
 REFCNTS |as|
 I |from|
 1
-       |do|
 (COND
-                   ((AND (NEQ (\\REFCNT (CAR TAIL))
-                              (ADD1 CNT))
-                         (NOT (|fetch|
 (MDSTYPEWORD NOREFCNT)
-                                 |of|
 (\\ADDBASE |\\MDSTypeTable| (LRSH (|fetch|
 (POINTER
-                                                                                          PAGE#)
-                                                                               |of|
 (CAR TAIL))
-                                                                            1)))))
-                    (HELP (CONCAT "Ref cnt of " I "th RESTLIST element was not incremented")
-                          (CONCAT "Was " CNT ", now is " (\\REFCNT (CAR TAIL)))))
-                   ((NEQ (\\REFCNT TAIL)
-                         (COND
-                            ((EQ TAIL RESULT)
-                             0)
-                            (T 1)))
-                    (HELP (COND
-                             ((EQ TAIL RESULT)
-                              "Ref cnt of RESTLIST value is not zero")
-                             (T "Ref cnt of RESTLIST tail is not one"))
-                          (\\REFCNT TAIL)))))
-    T))
-)
-
-(RPAQ? RESTLISTCOUNTER 0)
-(DECLARE\: EVAL@COMPILE DONTCOPY 
-(DECLARE\: EVAL@COMPILE 
-
-(PUTPROPS RESTLISTCHECK DMACRO (DEFMACRO (N) (BQUOTE (PROGN (RECLAIM) (DORESTLISTTEST1 (GETRESTARGREFCNTS (\\\, N)) ((OPCODES RESTLIST (\\\, N)) NIL KEYARGS) (\\\, N))))))
-
-(PUTPROPS \\COMPUTED.FORM MACRO (X (CONS (QUOTE PROGN) (MAPCAR X (FUNCTION EVAL)))))
-)
-
-(DECLARE\: EVAL@COMPILE
-
-(BLOCKRECORD MDSTYPEWORD
 ((NOREFCNT FLAG) (NIL BITS 15)))
-)
-
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS RESTLISTCOUNTER)
-)
-)
-
-(DEFTEST (RESTLIST :COMPILED) (RESTLISTTESTER))
-
-
-
-(* \; "Closure tests")

-
-(DEFINEQ
-
-(CLOSURETESTER

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (|for|
 D |from|
 0 |to|
 (OR DEPTH CLOSURETEST.DEPTH) |always|
 (CLOSUREMAINTEST

-                                                                                  D))))
-
-(CLOSUREMAINTEST

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "21-Jul-86 16:40")

-    (COND
-       ((OR (NULL DEPTH)
-            (LEQ DEPTH 0))
-        (LET (VALUE)
-             (PUTD 'CLOSUREFN4 (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM DEFPOINTER)
-                                                         |of|
 'CLOSUREFN4CODE)
-                                      CLOSURETEST.ENVIRONMENT))
-             (COND
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (GETD 'CLOSUREFN1)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN1VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN1 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (FUNCALL (MAKE-COMPILED-CLOSURE (|fetch|
 (LITATOM 
-                                                                                           DEFPOINTER
-                                                                                             )
-                                                                            |of|
 'CLOSUREFN2)
-                                                         CLOSURETEST.ENVIRONMENT)
-                                                'A
-                                                'B
-                                                'C))
-                             (CLOSUREFN2VALUE
 'A 'B 'C)))
-                 (HELP "CLOSUREFN2 returned the wrong value" VALUE))
-                ((NOT (EQUAL (SETQ VALUE (CLOSUREFN4))
-                             (CLOSUREFN4VALUE
)))
-                 (HELP "CLOSUREFN4 returned the wrong value" VALUE))
-                (T T))))
-       (T                                                    (* \; 
-
                                 "Separate call so the compiler doesn't optimize out the recursion")

-          (CLOSUREMAINTEST.RECURSE
 (SUB1 DEPTH))))))
-
-(CLOSUREMAINTEST.RECURSE

-  (LAMBDA (DEPTH)
                                        (* |bvm:| "18-Jul-86 14:07")

-    (CLOSUREMAINTEST
 DEPTH)))
-
-(CLOSUREFNCHECK

-  (LAMBDA (CLOSUREP FUNCALLP)
                            (* |bvm:| "18-Jul-86 14:48")

-    (LET* ((CALLER (\\MYALINK))
-           (PVAR0 (STACKADDBASE (|fetch|
 (FX FIRSTPVAR) |of|
 CALLER))))
-          (COND
-             (CLOSUREP (COND
-                          ((NEQ (\\GETBASEPTR PVAR0 0)
-                                CLOSURETEST.ENVIRONMENT)
-                           (HELP (COND
-                                    (FUNCALLP "FUNCALL of a full closure")
-                                    (T "Call to symbol with Closure definition"))
-                                 " did not store closure environment in pvar0"))))
-             ((|fetch|
 (PVARSLOT BOUND) |of|
 PVAR0)
-              (HELP "FUNCALL of a null closure stored something into pvar0"))))))
-
-(CLOSUREFNCHECK2

-  (LAMBDA NIL
                                            (* |bvm:| "18-Jul-86 14:51")

-                                                             (* \; 
-
                                                           "Nothing really to check for now")

-    NIL))
-
-(CLOSUREFN1

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN1VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN1VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:30")

-    (LIST ARG1 ARG2 ARG3 ARG4)))
-
-(CLOSUREFN2

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-                                                             (* \; 
-
                                                           "Vanilla closure called via FUNCALL")

-    (CLOSUREFNCHECK
 T T)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN2VALUE
 ARG1 ARG2 ARG3 ARG4))))
-
-(CLOSUREFN2VALUE

-  (LAMBDA (ARG1 ARG2 ARG3 ARG4)
                          (* |bvm:| "18-Jul-86 15:37")

-    (LIST ARG4 ARG3 ARG2 ARG1)))
-
-(CLOSUREFN4CODE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:53")

-                                                             (* \; "closure called via FNx")

-    (CLOSUREFNCHECK
 T NIL)
-    (LET ((DUMMY1 T)
-          (DUMMY2 NIL))
-         (DECLARE
 (SPECVARS DUMMY1 DUMMY2))
-         (CLOSUREFNCHECK2
)
-         (CLOSUREFN4VALUE
 ARG1 ARG2 ARG3))))
-
-(CLOSUREFN4VALUE

-  (LAMBDA (ARG1 ARG2 ARG3)
                               (* |bvm:| "18-Jul-86 15:38")

-    (LIST ARG2 ARG3 ARG1)))
-)
-
-(RPAQ? CLOSURETEST.DEPTH 50)
-
-(RPAQ? CLOSURETEST.ENVIRONMENT "Closure Environment")
-(DECLARE\: DOEVAL@COMPILE DONTCOPY
-
-(GLOBALVARS CLOSURETEST.DEPTH CLOSURETEST.ENVIRONMENT)
-)
-
-(DEFTEST (CLOSURES :COMPILED) (CLOSURETESTER))
-
-
-
-(* \; "Free-variable lookup")

-
-(DEFINEQ
-
-(FVARTEST0

-(LAMBDA NIL (* \; "Edited  2-Aug-88 23:04 by FS") (SETTOPVAL (QUOTE TOPLEVEL1) 1) (SETTOPVAL (QUOTE TOPLEVEL2) 2) (SETTOPVAL (QUOTE NITERS) 3) (EQ (ITIMES NITERS 334) (FVARTEST1 100 200 4)))
-)
-
-(FVARTEST1

-(LAMBDA (IVAR1 IVAR2 DEPTH) (* \; "Edited  2-Aug-88 23:02 by FS") (* |;;| "Recurse DEPTH times and then call FVARTEST2 to test free variable lookup.") (LET (PVAR1) (* |;;| "This block is here so that name table scanning will find it, but must skip it.  PRINT so the compiler won't throw the block away.") (SETQ PVAR1 DEPTH) (PRINTOUT T "AT DEPTH " PVAR1 T)) (LET (PVAR1 PVAR2) (SETQ PVAR1 10) (SETQ PVAR2 20) (COND ((<= DEPTH 0) (FVARTEST2 4)) (T (FVARTEST1 IVAR1 IVAR2 (SUB1 DEPTH))))))
-)
-
-(FVARTEST2

-(LAMBDA (DEPTH) (* \; "Edited  2-Aug-88 22:56 by FS") (* |;;| "Recurse DEPTH times and then freely reference IVars, PVars, Globals.") (* |;;| "") (* |;;| "It needs to search past its own frames (the vars are unbound), and past FVARTEST1's frames for the globals.") (* |;;| "") (* |;;| "It will  find IVARx, PVARx in FVARTEST1's frames.") (* |;;| "") (* |;;| " Loop based on the freely referenced NITERS, to test FVAR  caching.") (PROG (NAMETBLE1 NAMETBLE2 TOTAL) (COND ((<= DEPTH 0) (SETQ TOTAL 0) (|for| I |from| 1 |to| NITERS |do| (SETQ TOTAL (+ TOTAL IVAR1 IVAR2 PVAR1 PVAR2 TOPLEVEL1 TOPLEVEL2 (FVARTEST3)))) (RETURN TOTAL)) (T (RETURN (FVARTEST2 (SUB1 DEPTH)))))))
-)
-
-(FVARTEST3

-(LAMBDA NIL (* \; "Edited  2-Aug-88 22:54 by FS") (* |;;| "Should find TOPLEVEL1 in FVARTEST2's frame (no way to test if this is really happening, but it should test a branch of the C code.") TOPLEVEL1)
-)
-)
-
-(DEFTEST FREE-VAR-LOOKUP (FVARTEST0))
-
-
-
-(* \; "AREF opcode tests")

-
-
-(RPAQQ *NON-CONSTANT-FLOAT-1* 1.0)
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-BIT "Opcode aref1, type (unsigned-byte 1)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 1)) :INITIAL-CONTENTS (QUOTE (0 1 0 1)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 1)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-BYTE "Opcode aref1, type (unsigned-byte 8)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :INITIAL-CONTENTS (QUOTE (0 34 56 255 23)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-WORD "Opcode aref1, type (unsigned-byte 16)" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 16)) :INITIAL-CONTENTS (QUOTE (0 34 255 65535 23)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 16)) :DISPLACED-TO XCL-USER::ARRAY-1))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-SIGNED-WORD "Opcode aref1, type (signed-byte 16)" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:SIGNED-BYTE 16)) :INITIAL-CONTENTS (QUOTE (0 -34 255 -32768 23))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-FIXP "Opcode aref1, type (signed-byte 32)" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE (CL:SIGNED-BYTE 32)) :INITIAL-CONTENTS (QUOTE (0 -34 258 -65538 2147483647))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-FLOATP "Opcode aref1, type single-float" (LET ((CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE CL:SINGLE-FLOAT) :INITIAL-CONTENTS (QUOTE (0.0 -34.0 3.456756E+35 -5.768E-34 5.4524))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CL:AREF CL:ARRAY XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-STRING-CHAR "Opcode aref1, type string-char" (LET ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 3 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :INITIAL-CONTENTS (QUOTE (#\Space #\a #\b)))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 3 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :FATP T :INITIAL-CONTENTS (QUOTE (#\Space #\Greek-0 #\Greek-32))))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 3) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-POINTER "Opcode aref1, type t" (LET* ((XCL-USER::LST (LIST 0 (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B)) (+ *NON-CONSTANT-FLOAT-1* 3.4) (QUOTE XCL-USER::C) (CONS (QUOTE XCL-USER::D) (QUOTE XCL-USER::E)))) (CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE T :INITIAL-CONTENTS XCL-USER::LST))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CONS (CL:AREF CL:ARRAY XCL-USER::I) (\\REFCNT (CL:AREF CL:ARRAY XCL-USER::I))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-XPOINTER "Opcode aref1, type il:xpointer" (LET* ((XCL-USER::LST (LIST 0 (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B)) (+ *NON-CONSTANT-FLOAT-1* 3.4) (QUOTE XCL-USER::C) (CONS (QUOTE XCL-USER::D) (QUOTE XCL-USER::E)))) (* |;;| "The IL:*NON-CONSTANT-FLOAT-1* is there to prevent using a constant float and getting screwed by refcount.") (CL:ARRAY (CL:MAKE-ARRAY 5 :ELEMENT-TYPE (QUOTE XPOINTER) :INITIAL-CONTENTS XCL-USER::LST))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 5) (XCL:COLLECT (CONS (CL:AREF CL:ARRAY XCL-USER::I) (\\REFCNT (CL:AREF CL:ARRAY XCL-USER::I))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::AREF1-PUNT "Opcode aref1, punt cases" (LET* ((XCL-USER::ARRAY-1 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :DISPLACED-TO (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:STRING-CHAR) :INITIAL-CONTENTS (QUOTE (#\a #\b #\c #\d))))) (XCL-USER::ARRAY-2 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE T :ADJUSTABLE T :INITIAL-CONTENTS (QUOTE (0 XCL-USER::A XCL-USER::B (XCL-USER::A . XCL-USER::B))))) (XCL-USER::ARRAY-3 (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE (CL:UNSIGNED-BYTE 8)) :READ-ONLY-P T :INITIAL-CONTENTS (QUOTE (0 1 2 3))))) (* |;;| "aref1 should punt on all these cases") (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-1 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-2 XCL-USER::I)) (XCL:COLLECT (CL:AREF XCL-USER::ARRAY-3 XCL-USER::I))))))
-
-
-
-(* |;;| "array-read and array-write ")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-BIT "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 1)" (CL:FLET ((XCL-USER::ARRAY-READ-BIT (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 0 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 8 0))) (\\PUTBASEBYTE XCL-USER::BASE 0 160) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-BIT XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-BYTE "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 8)" (CL:FLET ((XCL-USER::ARRAY-READ-BYTE (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 3 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 3))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 4)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEBYTE XCL-USER::BASE XCL-USER::I (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-BYTE XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-WORD "Opcode ARRAYREAD (MISC3 9), type (unsigned-byte 16)" (CL:FLET ((XCL-USER::ARRAY-READ-WORD (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 4 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 4))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 65535)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-WORD XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-SIGNED-WORD "Opcode ARRAYREAD (MISC3 9), type (signed-byte 16)" (CL:FLET ((XCL-USER::ARRAY-READ-SIGNED-WORD (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 20 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 20))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 255 -32768)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (\\LOLOC (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-SIGNED-WORD XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FIXP "Opcode ARRAYREAD (MISC3 9), type (signed-byte 32)" (CL:FLET ((XCL-USER::ARRAY-READ-FIXP (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 22 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 22))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 65536 -2147483648)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEFIXP XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FIXP XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FLOATP "Opcode ARRAYREAD (MISC3 9), type single-float" (CL:FLET ((XCL-USER::ARRAY-READ-FLOATP (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 54 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 54))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0.0 -23.0 3.4456E+24 -4.562435E-12)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEFLOATP XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FLOATP XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-THIN-CHAR "Opcode ARRAYREAD (MISC3 9), type string-char" (CL:FLET ((XCL-USER::ARRAY-READ-THIN-CHAR (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 67 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 67))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEBYTE XCL-USER::BASE XCL-USER::I (CL:CHAR-CODE (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-THIN-CHAR XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-FAT-CHAR "Opcode ARRAYREAD (MISC3 9), type fat-string-char" (CL:FLET ((XCL-USER::ARRAY-READ-FAT-CHAR (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 68 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 68))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASE XCL-USER::BASE XCL-USER::I (CL:CHAR-CODE (CAR XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-FAT-CHAR XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-POINTER "Opcode ARRAYREAD (MISC3 9), type t" (CL:FLET ((XCL-USER::ARRAY-READ-POINTER (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 38 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 38))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (2 #\c 2.3 (XCL-USER::A . XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\RPLPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-POINTER XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-READ-XPOINTER "Opcode ARRAYREAD (MISC3 9), type il:xpointer" (CL:FLET ((XCL-USER::ARRAY-READ-XPOINTER (XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC3 9) XCL-USER::BASE 86 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 86))) (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (2 #\c 2.3 (XCL-USER::A . XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (\\PUTBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1) (CAR XCL-USER::X))) (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (XCL-USER::ARRAY-READ-XPOINTER XCL-USER::BASE XCL-USER::I)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-BIT "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 1)" (CL:FLET ((XCL-USER::ARRAY-WRITE-BIT (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 0 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 8 0))) (\\PUTBASEBYTE XCL-USER::BASE 0 160) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (1 0 1 0)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-BIT (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (LET ((BYTE (\\GETBASEBYTE XCL-USER::BASE 0))) (LIST (LDB (BYTE 1 7) BYTE) (LDB (BYTE 1 6) BYTE) (LDB (BYTE 1 5) BYTE) (LDB (BYTE 1 4) BYTE))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-BYTE "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 8)" (CL:FLET ((XCL-USER::ARRAY-WRITE-BYTE (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 3 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 3))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 4)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-BYTE (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEBYTE XCL-USER::BASE XCL-USER::I)))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-WORD "Opcode ARRAYWRITE (MISC4 7), type (unsigned-byte 16)" (CL:FLET ((XCL-USER::ARRAY-WRITE-WORD (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 4 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 4))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 23 255 65535)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-WORD (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASE XCL-USER::BASE XCL-USER::I)))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-SIGNED-WORD "Opcode ARRAYWRITE (MISC4 7), type (signed-byte 16)" (CL:FLET ((XCL-USER::ARRAY-WRITE-SIGNED-WORD (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 20 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 20))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 255 -32768)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-SIGNED-WORD (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (LET ((XCL-USER::WORD (\\GETBASE XCL-USER::BASE XCL-USER::I))) (CL:IF (> XCL-USER::WORD 32767) (\\VAG2 15 XCL-USER::WORD) XCL-USER::WORD))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FIXP "Opcode ARRAYWRITE (MISC4 7), type (signed-byte 32)" (CL:FLET ((XCL-USER::ARRAY-WRITE-FIXP (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 22 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 22))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0 -23 65536 -2147483648)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FIXP (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEFIXP XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FLOATP "Opcode ARRAYWRITE (MISC4 7), type single-float" (CL:FLET ((XCL-USER::ARRAY-WRITE-FLOATP (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 54 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 54))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (0.0 -23.0 3.4456E+24 -4.562435E-12)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FLOATP (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (\\GETBASEFLOATP XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-THIN-CHAR "Opcode ARRAYWRITE (MISC4 7), type thin-string-char" (CL:FLET ((XCL-USER::ARRAY-WRITE-THIN-CHAR (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 67 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 67))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-THIN-CHAR (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:CODE-CHAR (\\GETBASEBYTE XCL-USER::BASE XCL-USER::I))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-FAT-CHAR "Opcode ARRAYWRITE (MISC4 7), type fat-string-char" (CL:FLET ((XCL-USER::ARRAY-WRITE-FAT-CHAR (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 68 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 68))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (QUOTE (#\a #\b #\c #\A)) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-FAT-CHAR (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CL:CODE-CHAR (\\GETBASE XCL-USER::BASE XCL-USER::I))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-POINTER "Opcode ARRAYWRITE (MISC4 7), type t" (CL:FLET ((XCL-USER::ARRAY-WRITE-POINTER (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 38 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 38))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (LIST 2 #\c (QUOTE XCL-USER::A) (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-POINTER (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CONS (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1)) (\\REFCNT (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::ARRAY-WRITE-XPOINTER "Opcode ARRAYWRITE (MISC4 7), type il:xpointer" (CL:FLET ((XCL-USER::ARRAY-WRITE-XPOINTER (XCL-USER::NEW-VALUE XCL-USER::BASE XCL-USER::INDEX) ((OPCODES MISC4 7) XCL-USER::NEW-VALUE XCL-USER::BASE 86 XCL-USER::INDEX))) (LET ((XCL-USER::BASE (%MAKE-ARRAY-STORAGE 4 86))) (XCL:WITH-COLLECTION (CL:DO ((XCL-USER::I 0 (CL:1+ XCL-USER::I)) (XCL-USER::X (LIST 2 #\c (QUOTE XCL-USER::A) (CONS (QUOTE XCL-USER::A) (QUOTE XCL-USER::B))) (CDR XCL-USER::X))) ((EQ XCL-USER::I 4)) (XCL:COLLECT (XCL-USER::ARRAY-WRITE-XPOINTER (CAR XCL-USER::X) XCL-USER::BASE XCL-USER::I))) (XCL:COLLECT (XCL:WITH-COLLECTION (CL:DOTIMES (XCL-USER::I 4) (XCL:COLLECT (CONS (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1)) (\\REFCNT (\\GETBASEPTR XCL-USER::BASE (CL:ASH XCL-USER::I 1))))))))))))
-
-
-
-(* |;;| "Boxed opcodes")

-
-
-(RPAQQ *NON-CONSTANT-T* T)
-
-(RPAQQ *NON-CONSTANT-0* 0)
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT+ "Opcodes IPLUS,FPLUS, and PLUS, both args integer" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1 -3 9834756987354 21845 -54))) (CL:DOLIST (XCL-USER::Y (QUOTE (1 -3 9834756987354 21845 -54))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT+ "Opcodes IPLUS,FPLUS, and PLUS, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 -3.0 -3.4028235E+38 21845.0 -54.0))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED+ "Opcodes IPLUS,FPLUS, and PLUS, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 -3 1/3 9834756987354 21845 -54))) (XCL:COLLECT (IPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FPLUS XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (PLUS XCL-USER::X XCL-USER::Y))))))
-
-(DEFTESTGROUP ERROR+ (DO-TEST T-FIRST (EXPECT-ERRORS (T) (+ *NON-CONSTANT-T* 3))) (DO-TEST T-SECOND (EXPECT-ERRORS (T) (+ 3 *NON-CONSTANT-T*))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 3 9834756987354 21845 -54))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 3.0 3.4028235E+38 21845.0 -54.0))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1 3 1/3 9834756987354 21845 -54))) (XCL:COLLECT (IDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FDIFFERENCE XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (DIFFERENCE XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT* "Opcodes ITIMES,FTIMES, and TIMES, both args integer" (LET ((XCL-USER::X 3)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45 345235424 0 23 21845))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT* "Opcodes ITIMES,FTIMES, and TIMES, both args float" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45.0 0.0 1.1342745E+38 -21845.0))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED* "Opcodes ITIMES,FTIMES, and TIMES, mixed args" (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45 1/3 345235424 0 23 21845))) (XCL:COLLECT (ITIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FTIMES XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (TIMES XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args integer" (LET ((XCL-USER::X 21845)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1 345235424 -45))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args float" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, args mixed" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1 4/3 -1345619432 45))) (XCL:COLLECT (IQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FQUOTIENT XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (QUOTIENT XCL-USER::X XCL-USER::Y))))))
-
-(DEFTESTGROUP ERROR/T (DO-TEST T-DIVISOR (EXPECT-ERRORS (T) (/ 34 *NON-CONSTANT-T*))) (DO-TEST T-NUMERATOR (EXPECT-ERRORS (T) (/ *NON-CONSTANT-T* 34))))
-
-(DEFTEST ERROR/0 (EXPECT-ERRORS (T) (/ 34 *NON-CONSTANT-0*)))
-
-(DEFTEST NO-ERROR-0/0 (/ *NON-CONSTANT-0* *NON-CONSTANT-0*))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::INT> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 -45 345235424 22000))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::FLOAT> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 22000.0))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::MIXED> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845 1/3 -45 5498457654 22000))) (XCL:COLLECT (IGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (FGREATERP XCL-USER::X XCL-USER::Y)) (XCL:COLLECT (GREATERP XCL-USER::X XCL-USER::Y))))))
-
-
-
-(* |;;| "Unboxed opcodes [scalar]")

-
-
-
-
-(* |;;| "Ubfloat1")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::BOX "Opcode BOX (UBFLOAT1 0)" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE ((16256 . 0) (0 . 0) (49716 . 0) (26309 . 45156)))) (XCL:COLLECT (\\FLOATBOX (\\VAG2 (CAR XCL-USER::X) (CDR XCL-USER::X)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UNBOX "Opcode UNBOX (UBFLOAT1 1)" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1.0 0.0 -45.0 4.6678E+23))) (LET ((XCL-USER::Y (\\FLOATUNBOX XCL-USER::X))) (XCL:COLLECT (CONS (\\HILOC XCL-USER::Y) (\\LOLOC XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBABS "Opcode UFABS (UBFLOAT1 2)" (CL:FLET ((XCL-USER::UBABS (XCL-USER::X) (\\FLOATBOX ((OPCODES UBFLOAT1 2) (\\FLOATUNBOX XCL-USER::X))))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBABS XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBNEGATE "Opcode UFNEGATE (UBFLOAT1 3)" (CL:FLET ((XCL-USER::UBNEGATE (XCL-USER::X) (\\FLOATBOX ((OPCODES UBFLOAT1 3) (\\FLOATUNBOX XCL-USER::X))))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBNEGATE XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBFIX "Opcode UFIX (UBFLOAT1 4)" (CL:FLET ((XCL-USER::UBFIX (XCL-USER::X) ((OPCODES UBFLOAT1 4) (\\FLOATUNBOX XCL-USER::X)))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (-1.0 0.0 -45.0 4.6678E+23))) (XCL:COLLECT (XCL-USER::UBFIX XCL-USER::X))))))
-
-
-
-(* |;;| "Ubfloat2")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB+ "Opcode UFADD (UBFLOAT2 0)" (CL:FLET ((XCL-USER::UB+ (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 0) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 -3.0 -3.4028235E+38 21845.0 3))) (XCL:COLLECT (XCL-USER::UB+ XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB- "Opcode UFSUB (UBFLOAT2 1)" (CL:FLET ((XCL-USER::UB- (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((* |;;| "ub -") (OPCODES UBFLOAT2 1) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (1.0 3.0 3.4028235E+38 21845 1/3 -54.0))) (XCL:COLLECT (XCL-USER::UB- XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB* "Opcode UFMULT (UBFLOAT2 3)" (CL:FLET ((XCL-USER::UB* (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 3) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 3.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (45.0 0.0 1.1342745E+38 -21845.0))) (XCL:COLLECT (XCL-USER::UB* XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB/ "Opcode UFDIV (UBFLOAT2 4)" (CL:FLET ((XCL-USER::UB/ (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 4) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (0.001 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (XCL:COLLECT (XCL-USER::UB/ XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UB> "Opcode UFGREAT (UBFLOAT2 5)" (CL:FLET ((XCL-USER::UB> (XCL-USER::X XCL-USER::Y) ((OPCODES UBFLOAT2 5) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y)))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UB> XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBMAX "Opcode UFMAX (UBFLOAT2 6)" (CL:FLET ((XCL-USER::UBMAX (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 6) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UBMAX XCL-USER::X XCL-USER::Y)))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::UBMIN "Opcode UFMAX (UBFLOAT2 7)" (CL:FLET ((XCL-USER::UBMIN (XCL-USER::X XCL-USER::Y) (\\FLOATBOX ((OPCODES UBFLOAT2 7) (\\FLOATUNBOX XCL-USER::X) (\\FLOATUNBOX XCL-USER::Y))))) (LET ((XCL-USER::X 21845.0)) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::Y (QUOTE (21845.0 -45.0 3.4523542E+8 0.001))) (XCL:COLLECT (XCL-USER::UBMIN XCL-USER::X XCL-USER::Y)))))))
-
-
-
-(* |;;| "Ubfloat3")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::POLY "Opcode POLY (UBFLOAT3 0)" (CL:FLET ((XCL-USER::POLY (XCL-USER::X XCL-USER::BASE XCL-USER::SIZE) (\\FLOATBOX ((OPCODES UBFLOAT3 0) (\\FLOATUNBOX XCL-USER::X) XCL-USER::BASE XCL-USER::SIZE)))) (LET* ((CL:ARRAY (CL:MAKE-ARRAY 4 :ELEMENT-TYPE (QUOTE CL:SINGLE-FLOAT) :INITIAL-CONTENTS (QUOTE (1.0 2.0 3.0 4.0)))) (XCL-USER::BASE (%ARRAY-BASE CL:ARRAY))) (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::PAIR (QUOTE ((1.0 . 3) (1.0 . 1) (3.5 . 3)))) (XCL:COLLECT (XCL-USER::POLY (CAR XCL-USER::PAIR) XCL-USER::BASE (CDR XCL-USER::PAIR))))))))
-
-
-
-(* |;;| "Transcendentals --- stress test")

-
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::SIN-TEST "Function SIN" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (0.0 1/3 -1.2 12.6))) (XCL:COLLECT (CL:SIN (CL:* CL:PI XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::COS-TEST "Function COS" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (0.0 1/3 -1.2 12.6))) (XCL:COLLECT (CL:COS (CL:* CL:PI XCL-USER::X))))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::EXP-TEST "Function EXP" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (1.0 20.5 1/3 -5.2))) (XCL:COLLECT (CL:EXP XCL-USER::X)))))
-
-(XCL-USER::DEFINE-VERIFIED-TEST XCL-USER::LOG-TEST "Function LOG" (XCL:WITH-COLLECTION (CL:DOLIST (XCL-USER::X (QUOTE (2.7182817 -2.0 453.78))) (XCL:COLLECT (CL:LOG XCL-USER::X)))))
-(DECLARE\: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 
-
-(ADDTOVAR NLAMA)
-
-(ADDTOVAR NLAML)
-
-(ADDTOVAR LAMA DORESTLISTTEST DOFINDKEYTEST)
-)
-(PUTPROPS OPCODES.TEST COPYRIGHT ("ENVOS Corporation" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (11344 11569 (ADDR-IN-RANGE 11354 . 11567)) (13698 20481 (UNWINDTESTER 13708 . 14129) (
-UNWINDMAINTEST 14131 . 17139) (UNWINDMAINTEST.RECURSE 17141 . 17310) (UNWINDCHECK1 17312 . 17610) (
-UNWINDCHECK2 17612 . 20277) (UNWINDCODE 20279 . 20479)) (20882 24141 (UW2.TEST 20892 . 21323) (
-UW2.RECURSE 21325 . 21564) (UW2.TEST.MAIN 21566 . 22223) (UW2.CHECK 22225 . 23833) (UW2.IDENTITY 23835
- . 24139)) (24307 25912 (FINDKEYTESTER 24317 . 24531) (DOFINDKEYTEST 24533 . 25413) (DOFINDKEYTEST1 
-25415 . 25910)) (26202 30591 (\\RESTLIST.SPLICE.FRAME 26212 . 27546) (RESTLISTTESTER 27548 . 28122) (
-DORESTLISTTEST 28124 . 28493) (GETRESTARGREFCNTS 28495 . 28716) (DORESTLISTTEST1 28718 . 30589)) (
-31179 36595 (CLOSURETESTER 31189 . 31491) (CLOSUREMAINTEST 31493 . 33494) (CLOSUREMAINTEST.RECURSE 
-33496 . 33652) (CLOSUREFNCHECK 33654 . 34457) (CLOSUREFNCHECK2 34459 . 34753) (CLOSUREFN1 34755 . 
-35244) (CLOSUREFN1VALUE 35246 . 35393) (CLOSUREFN2 35395 . 35884) (CLOSUREFN2VALUE 35886 . 36033) (
-CLOSUREFN4CODE 36035 . 36449) (CLOSUREFN4VALUE 36451 . 36593)) (36860 38494 (FVARTEST0 36870 . 37077) 
-(FVARTEST1 37079 . 37583) (FVARTEST2 37585 . 38271) (FVARTEST3 38273 . 38492)))))
-STOP

internal/test/Maiko/Aux/optests.lisp.~1~

@@ -1,26 +0,0 @@
-;;; Random opcode tests
-
-(in-package "XCL-USER")
-
-(defun copy.n.test (use-ufn)
-  "Tests a case of the COPY.N opcode. Both (COPY.N.TEST NIL) and (COPY.N.TEST T) should return :OK"
-  (if use-ufn
-      (progn ((il:opcodes il:copy) 2 1 :ok -1 -2) ; the COPY compensates for a POP
-             (funcall (il:\\getufnentry 'il:copy.n) 4))
-    ((il:opcodes il:copy.n 4) 2 1 :ok -1 -2)))
-
-(defun store.n.test (use-ufn)
-  "Tests a case of the STORE.N opcode. Both (STORE.N.TEST NIL) and (STORE.N.TEST T) should return the list (5 4 t 2 1)"
-  (if use-ufn
-      (progn ((il:opcodes il:copy) 5 4 3 2 1)
-             (funcall (il:\\getufnentry 'il:store.n) t 4))
-    ((il:opcodes il:store.n 4) 5 4 3 2 1 t))
-  ((il:opcodes il:applyfn) 5 'list))
-
-(defun pop.n.test (use-ufn)
-  "Tests a case of the STORE.N opcode. Both (POP.N.TEST NIL) and (POP.N.TEST T) should return 2"
-  (if use-ufn
-      (progn ((il:opcodes il:copy) 4 3 2 1 0)
-             (funcall (il:\\getufnentry 'il:pop.n) 2))
-    ((il:opcodes il:pop.n 2) 4 3 2 1 0)))
-

internal/test/Maiko/Aux/optests.lisp.~2~

@@ -1,26 +0,0 @@
-;;; Random opcode tests
-
-(in-package "XCL-USER")
-
-(defun copy.n.test (use-ufn)
-  "Tests a case of the COPY.N opcode. Both (COPY.N.TEST NIL) and (COPY.N.TEST T) should return :OK"
-  (if use-ufn
-      (progn ((il:opcodes il:copy) 2 1 :ok -1 -2) ; the COPY compensates for a POP
-             (funcall (il:\\getufnentry 'il:copy.n) 4))
-    ((il:opcodes il:copy.n 4) 2 1 :ok -1 -2)))
-
-(defun store.n.test (use-ufn)
-  "Tests a case of the STORE.N opcode. Both (STORE.N.TEST NIL) and (STORE.N.TEST T) should return the list (5 4 t 2 1)"
-  (if use-ufn
-      (progn ((il:opcodes il:copy) 5 4 3 2 1)
-             (funcall (il:\\getufnentry 'il:store.n) t 4))
-    ((il:opcodes il:store.n 4) 5 4 3 2 1 t))
-  ((il:opcodes il:applyfn) 5 'list))
-
-(defun pop.n.test (use-ufn)
-  "Tests a case of the STORE.N opcode. Both (POP.N.TEST NIL) and (POP.N.TEST T) should return 2"
-  (if use-ufn
-      (progn ((il:opcodes il:copy) 4 3 2 1 0)
-             (funcall (il:\\getufnentry 'il:pop.n) 2))
-    ((il:opcodes il:pop.n 2) 4 3 2 1 0)))
-

internal/test/Maiko/HAND/MAIKO-ARRAY-TESTS.~1~

@@ -1,519 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "22-Jun-88 13:52:22" {ERIS}<TEST>MAIKO>HAND>MAIKO-ARRAY-TESTS.\;8
 30798  
-
-      |changes| |to:|  (FNS MAIKO-ARRAY-TESTS SIMPLE-AREF-ASET-TESTS)
-                       (FUNCTIONS USER::BYTE-ARRAY-TESTS USER::CHAR-ARRAY-TESTS 
-                              USER::FLOAT-ARRAY-TESTS USER::XPOINTER-ARRAY-TESTS 
-                              USER::PAST-ARRAY-FAILURE-CASES USER::POINTER-ARRAY-TESTS 
-                              USER::BIT-ARRAY-TESTS)
-                       (VARS MAIKO-ARRAY-TESTSCOMS)
-
-      |previous| |date:| "12-Jun-88 18:13:25" {ERIS}<TEST>MAIKO>HAND>MAIKO-ARRAY-TESTS.\;7)
-
-
-(PRETTYCOMPRINT MAIKO-ARRAY-TESTSCOMS)
-
-(RPAQQ MAIKO-ARRAY-TESTSCOMS
 (
-                                  (* |;;| "Tests for AREF & ASET in Maiko")

-
-                                  
-                                  (* |;;| "TO DO:  Extendable arrays, Adjustable arrays, extend past 2**15 and make sure contents are still there.  Vectors, strings.")

-
-                                  
-                                  (* |;;| "Main test invokation function:")

-
-                                  (FNS MAIKO-ARRAY-TESTS)
-                                  
-                                  (* |;;| "1-dimensional array tests:")

-
-                                  (FUNCTIONS USER::BIT-ARRAY-TESTS USER::BYTE-ARRAY-TESTS 
-                                         USER::CHAR-ARRAY-TESTS USER::FLOAT-ARRAY-TESTS 
-                                         USER::POINTER-ARRAY-TESTS USER::XPOINTER-ARRAY-TESTS)
-                                  
-                                  (* |;;| "Simple AREF & ASET of 1-, 2-, 3-d # arrays:")

-
-                                  (FNS SIMPLE-AREF-ASET-TESTS NEQP)
-                                  
-                                  (* |;;| "Test of past known failures")

-
-                                  (FUNCTIONS USER::PAST-ARRAY-FAILURE-CASES)
-                                  
-                                  (* |;;| "Assure that we compile with CL:COMPILE-FILE:")

-
-                                  (PROPS (MAIKO-ARRAY-TESTS FILETYPE))))
-
-
-
-(* |;;| "Tests for AREF & ASET in Maiko")

-
-
-
-
-(* |;;| 
-"TO DO:  Extendable arrays, Adjustable arrays, extend past 2**15 and make sure contents are still there.  Vectors, strings."
-)

-
-
-
-
-(* |;;| "Main test invokation function:")

-
-(DEFINEQ
-
-(MAIKO-ARRAY-TESTS

-  (LAMBDA (LIMIT)
                                        (* \; "Edited 22-Jun-88 13:51 by jds")

-
-    (* |;;| "Main entry point to the Maiko array op-code tests.")

-
-    (|for|
 I |from|
 1 |to|
 LIMIT |do|
 (PRINTOUT T T 
-                                                    "Starting Maiko array op-code tests, iteration #"
-                                                             I T)
-                                                   (USER::BIT-ARRAY-TESTS 2)
-                                                   (USER::BYTE-ARRAY-TESTS 2)
-                                                   (USER::CHAR-ARRAY-TESTS 2)
-                                                   (USER::FLOAT-ARRAY-TESTS 2)
-                                                   (USER::POINTER-ARRAY-TESTS 2)
-                                                   (USER::XPOINTER-ARRAY-TESTS 2)
-                                                   (PRINTOUT T 
-                                                    "  Starting #-array aref/set tests for 1-3 dims."
-                                                          )
-                                                   (SIMPLE-AREF-ASET-TESTS
)
-                                                   (USER::PAST-ARRAY-FAILURE-CASES 1))))
-)
-
-
-
-(* |;;| "1-dimensional array tests:")

-
-
-(CL:DEFUN USER::BIT-ARRAY-TESTS
 (USER::LIMIT)
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting bit-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'BIT 
-                                                      :INITIAL-ELEMENT 0))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'BIT 
-                                                     :INITIAL-ELEMENT 1)))
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        0)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                        1)
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               (COND
-                                                  ((EVENP USER::I)
-                                                   1)
-                                                  (T 0)))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (COND
-                                                           ((EVENP USER::I)
-                                                            1)
-                                                           (T 0)))
-                                               (CL:ERROR "EVENP pattern fails at ~D.~%" USER::I))))))
-          ))
-
-(CL:DEFUN USER::BYTE-ARRAY-TESTS
 (USER::LIMIT)
-
-   (* |;;| "Tests of byte arrays, for bytes of length 1, 8, 16, and 32 bits.")

-
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting byte-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::BYTE-LEN IN
 '(1 8 16 32) AS
 USER::MAX-VALUE
-               IN
 '(2 256 65535 65535)
-               DO
 (CL:FORMAT T "    Byte length = ~D~%" USER::BYTE-LEN)
-                     (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-                        IN
 '(8 16 32 32767 65535)
-                        DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                                      (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE
-                                                               (LIST 'CL:UNSIGNED-BYTE USER::BYTE-LEN
-                                                                     )
-                                                               :INITIAL-ELEMENT 0))
-                                      (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE
-                                                              (LIST 'CL:UNSIGNED-BYTE USER::BYTE-LEN)
-                                                              :INITIAL-ELEMENT 1)))
-                                     (CL:FORMAT T "   Array size = ~D~%" USER::LEN)
-                                     (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                                    ((= USER::I USER::LEN))
-                                                 (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                                 0)
-                                                        (CL:ERROR 
-                                                          "**Zero-array wasn't zero at element ~d.~%"
-                                                               USER::I))
-                                                 (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                                 1)
-                                                        (CL:ERROR 
-                                                            "**One-array wasn't one at element ~d.~%"
-                                                               USER::I))))
-                                     (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                                    ((= USER::I USER::LEN))
-                                                 (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (CL:REM USER::I USER::MAX-VALUE))
-                                                 (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                                 (CL:REM USER::I USER::MAX-VALUE))
-                                                        (CL:ERROR "EVENP pattern fails at ~D.~%" 
-                                                               USER::I)))))))))
-
-(CL:DEFUN USER::CHAR-ARRAY-TESTS
 (USER::LIMIT)
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting bit-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'CL:CHARACTER 
-                                                      :INITIAL-ELEMENT #\D))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'CL:CHARACTER 
-                                                     :INITIAL-ELEMENT (CL:INT-CHAR (CHARCODE "41,133"
-                                                                                          )))))
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (NEQ (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                      #\D)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (NEQ (CL:AREF USER::ONE-ARRAY USER::I)
-                                                      (CL:INT-CHAR (CHARCODE "41,133")))
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))))))
-
-(CL:DEFUN USER::FLOAT-ARRAY-TESTS
 (USER::LIMIT)
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting FLOAT-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'FLOAT 
-                                                      :INITIAL-ELEMENT 0.0))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'FLOAT 
-                                                     :INITIAL-ELEMENT 1.0)))
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        0.0)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                        1.0)
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               (CL:SIN (CL:* USER::I (/ 3.1415927 USER::LEN))))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (CL:SIN (CL:* USER::I (/ 3.1415927 USER::LEN)
-                                                                      )))
-                                               (CL:ERROR "SIN pattern fails at ~D.~%" USER::I))))
-
-                            (* |;;| "Just create 1000 of floats into the array, and read them out, so we can run STORAGE later to see if they leaked.")

-
-                            (CL:DO ((USER::I 0 (CL:1+ USER::I))
-                                    (CL:ELT (RAND 0 (CL:1- USER::LEN))
-                                           (RAND 0 (CL:1- USER::LEN))))
-                                   ((= USER::I 1000))
-                                (CL:SETF (CL:AREF USER::ZERO-ARRAY CL:ELT)
-                                       (CL:SIN (CL:* USER::I (/ 3.1415927 USER::LEN))))
-                                (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY CL:ELT)
-                                                (CL:SIN (CL:* USER::I (/ 3.1415927 USER::LEN))))
-                                       (CL:ERROR "SIN pattern fails at ~D.~%" USER::I)))))))
-
-(CL:DEFUN USER::POINTER-ARRAY-TESTS
 (USER::LIMIT)
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting pointer-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :INITIAL-ELEMENT 0))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :INITIAL-ELEMENT 1))
-                             (USER::GC-ITEM (CREATE
 FMTSPEC))
-                             USER::OLD-REFCNT)
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        0)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                        1)
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               (COND
-                                                  ((EVENP USER::I)
-                                                   1)
-                                                  (T 0)))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (COND
-                                                           ((EVENP USER::I)
-                                                            1)
-                                                           (T 0)))
-                                               (CL:ERROR "EVENP pattern fails at ~D.~%" USER::I))))
-
-                            (* |;;| 
-
                "Make sure that putting a pointer to something into an array adds to the refcount.")

-
-                            (ERSETQ (CL:SETQ USER::OLD-REFCNT (\\REFCNT USER::GC-ITEM))
-                                   (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                          ((= USER::I USER::LEN))
-                                       (CL:SETQ USER::OLD-REFCNT (\\REFCNT USER::GC-ITEM))
-                                       (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                              USER::GC-ITEM)
-                                       (OR (EQ (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               USER::GC-ITEM)
-                                           (CL:ERROR 
-                                                  "Filling array with GC sample item failed at ~D.~%"
-                                                  USER::I))
-                                       (CL:WHEN (CL:/= (\\REFCNT USER::GC-ITEM)
-                                                       (CL:1+ USER::OLD-REFCNT))
-                                              (CL:ERROR "ASET doesn't bump ref-count at ~D.~%" 
-                                                     USER::I)))
-                                   (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                          ((= USER::I USER::LEN))
-                                       (CL:SETQ USER::OLD-REFCNT (\\REFCNT USER::GC-ITEM))
-                                       (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                              NIL)
-                                       (OR (NOT (CL:AREF USER::ZERO-ARRAY USER::I))
-                                           (CL:ERROR "Filling array with NIL failed at ~D.~%" USER::I
-                                                  ))
-                                       (CL:WHEN (CL:/= (\\REFCNT USER::GC-ITEM)
-                                                       (CL:1+ USER::OLD-REFCNT))
-                                              (CL:ERROR 
-                                                   "ASET to NIL doesn't decrement ref-count at ~D.~%"
-                                                     USER::I))))))))
-
-(CL:DEFUN USER::XPOINTER-ARRAY-TESTS
 (USER::LIMIT)
-
-   (* |;;| "Tests of arrays of XPOINTERs.")

-
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting xpointer-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'XPOINTER 
-                                                      :INITIAL-ELEMENT 0))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'XPOINTER 
-                                                     :INITIAL-ELEMENT 1))
-                             (USER::GC-ITEMS (LIST (CREATE
 FMTSPEC)
-                                                   100000 3.55 (CONS 3 4)
-                                                   (COMPLEX 3.4 5)
-                                                   4/5
-                                                   #'(CL:LAMBDA (USER::X)
-                                                            (CL:PRINT (USER::DATE USER::X)))
-                                                   (CL:MAKE-ARRAY 5)))
-                             USER::GC-ITEM USER::OLD-REFCNT)
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        0)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                        1)
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               (COND
-                                                  ((EVENP USER::I)
-                                                   1)
-                                                  (T 0)))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (COND
-                                                           ((EVENP USER::I)
-                                                            1)
-                                                           (T 0)))
-                                               (CL:ERROR "EVENP pattern fails at ~D.~%" USER::I))))
-
-                            (* |;;| 
-
                "Make sure that putting a pointer to something into an array adds to the refcount.")

-
-                            (FOR
 USER::GC-ITEM IN
 USER::GC-ITEMS
-                               DO
 (CL:SETQ USER::OLD-REFCNT (\\REFCNT USER::GC-ITEM))
-                                     (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                                    ((= USER::I USER::LEN))
-                                                 (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        USER::GC-ITEM)
-                                                 (OR (EQ (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                         USER::GC-ITEM)
-                                                     (CL:ERROR 
-                                                  "Filling array with GC sample item failed at ~D.~%"
-                                                            USER::I))
-                                                 (CL:WHEN (CL:/= (\\REFCNT USER::GC-ITEM)
-                                                                 USER::OLD-REFCNT)
-                                                        (CL:ERROR "ASET bumps ref-count at ~D.~%" 
-                                                               USER::I)))
-                                            (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                                   ((= USER::I USER::LEN))
-                                                (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                       NIL)
-                                                (OR (NOT (CL:AREF USER::ZERO-ARRAY USER::I))
-                                                    (CL:ERROR 
-                                                           "Filling array with NIL failed at ~D.~%" 
-                                                           USER::I))
-                                                (CL:WHEN (CL:/= (\\REFCNT USER::GC-ITEM)
-                                                                USER::OLD-REFCNT)
-                                                       (CL:ERROR 
-                                                          "ASET to NIL decrements ref-count at ~D.~%"
-                                                              USER::I)))))))))
-
-
-
-(* |;;| "Simple AREF & ASET of 1-, 2-, 3-d # arrays:")

-
-(DEFINEQ
-
-(SIMPLE-AREF-ASET-TESTS

-  (LAMBDA NIL
                                            (* \; "Edited  9-Jun-88 19:02 by jds")

-
-    (* |;;| "Just run thru AREF and ASET on simple 1- 2- and 3-d arrays of numbers and make sure they look reasonable.")

-
-    (LET ((|array1d| (CL:MAKE-ARRAY '(10)
-                            :INITIAL-CONTENTS
-                            '(0 1 2 3 4 5 6 7 8 9)))
-          (|array2d| (CL:MAKE-ARRAY '(3 10)
-                            :INITIAL-CONTENTS
-                            '((0 1 2 3 4 5 6 7 8 9)
-                              (10 11 12 13 14 15 16 17 18 19)
-                              (20 21 22 23 24 25 26 27 28 29))))
-          (|array3d| (CL:MAKE-ARRAY '(2 3 10)
-                            :INITIAL-CONTENTS
-                            '(((0 1 2 3 4 5 6 7 8 9)
-                               (10 11 12 13 14 15 16 17 18 19)
-                               (20 21 22 23 24 25 26 27 28 29))
-                              ((100 101 102 103 104 105 106 107 108 109)
-                               (110 111 112 113 114 115 116 117 118 119)
-                               (120 121 122 123 124 125 126 127 128 129)))))
-          (|array1d-0| (CL:MAKE-ARRAY '(10)
-                              :INITIAL-ELEMENT "ASDF"))
-          (|array2d-0| (CL:MAKE-ARRAY '(3 10)
-                              :INITIAL-ELEMENT 3.5))
-          (|array3d-0| (CL:MAKE-ARRAY '(2 3 10)
-                              :INITIAL-ELEMENT
-                              '|array3d-0|)))
-
-         (* |;;| " 1 d array ref")

-
-         (|for|
 \i |from|
 0 |to|
 9 |do|
 (NEQP \i (CL:AREF |array1d| \i)
-                                                              '(CL:AREF |array1d| \i)))
-
-         (* |;;| " 2 d array ref")

-
-         (|for|
 \j |from|
 0 |to|
 2
-            |do|
 (|for|
 \i |from|
 0 |to|
 9
-                        |do|
 (NEQP (+ (TIMES \j 10)
-                                          \i)
-                                       (CL:AREF |array2d| \j \i)
-                                       '(CL:AREF |array2d| \j \i))))
-
-         (* |;;| "3 d aref")

-
-         (|for|
 \k |from|
 0 |to|
 1
-            |do|
 (|for|
 \j |from|
 0 |to|
 2
-                        |do|
 (|for|
 \i |from|
 0 |to|
 9
-                                    |do|
 (NEQP (+ (TIMES \k 100)
-                                                      (TIMES \j 10)
-                                                      \i)
-                                                   (CL:AREF |array3d| \k \j \i)
-                                                   '(CL:AREF |array3d| \k \j \i)))))
-
-         (* |;;| "1 d array set")

-
-         (|for|
 \i |from|
 0 |to|
 9 |do|
 (CL:SETF (CL:AREF |array1d-0| \i)
-                                                               (DIFFERENCE 10 \i)))
-
-         (* |;;| "1 d array ref")

-
-         (|for|
 \i |from|
 0 |to|
 9 |do|
 (NEQP (DIFFERENCE 10 \i)
-                                                              (CL:AREF |array1d-0| \i)
-                                                              '(CL:AREF |array1d-0| \i)))
-
-         (* |;;| "2 d array set")

-
-         (|for|
 \j |from|
 0 |to|
 2
-            |do|
 (|for|
 \i |from|
 0 |to|
 9
-                        |do|
 (CL:SETF (CL:AREF |array2d-0| \j \i)
-                                        (PLUS \j (TIMES \i 10)))))
-
-         (* |;;| "2 d aref")

-
-         (|for|
 \j |from|
 0 |to|
 2
-            |do|
 (|for|
 \i |from|
 0 |to|
 9
-                        |do|
 (NEQP (PLUS \j (TIMES \i 10))
-                                       (CL:AREF |array2d-0| \j \i)
-                                       '(CL:AREF |array2d-0| \j \i))))
-
-         (* |;;| " 3 d array set")

-
-         (|for|
 \k |from|
 0 |to|
 1
-            |do|
 (|for|
 \j |from|
 0 |to|
 2
-                        |do|
 (|for|
 \i |from|
 0 |to|
 9
-                                    |do|
 (CL:SETF (CL:AREF |array3d-0| \k \j \i)
-                                                    (PLUS \k (TIMES \j 10)
-                                                          (TIMES \i 100))))))
-
-         (* |;;| "3 d aref")

-
-         (|for|
 \k |from|
 0 |to|
 1
-            |do|
 (|for|
 \j |from|
 0 |to|
 2
-                        |do|
 (|for|
 \i |from|
 0 |to|
 9
-                                    |do|
 (NEQP (PLUS \k (TIMES \j 10)
-                                                         (TIMES \i 100))
-                                                   (CL:AREF |array3d-0| \k \j \i)
-                                                   '(CL:AREF |array3d-0| \k \j \i))))))))
-
-(NEQP

-  (LAMBDA (A B ERROR-MSG)
                            (* \; "Edited 12-Jun-88 18:13 by sybalsky")

-
-    (* |;;| "if  the two numbers A and B are not equal then halt with error message ERROR-MSG")

-
-    (OR (EQP A B)
-        (ERROR ERROR-MSG))))
-)
-
-
-
-(* |;;| "Test of past known failures")

-
-
-(CL:DEFUN USER::PAST-ARRAY-FAILURE-CASES
 (USER::LIMIT)
-
-   (* |;;| "Repository for past known failure cases, gleened from hand tests, ARs, and failed runs of this test suite.")

-
-   (CL:FORMAT T "  Starting test of past failure syndromes.~%")
-   (LET ((CL:ARRAY (CL:MAKE-ARRAY 57296 :ELEMENT-TYPE '(CL:UNSIGNED-BYTE 8)
-                          :INITIAL-ELEMENT 1)))
-        (CL:FORMAT T "   Test of array of 57296 (unsigned-byte 8)s inited to 1s.~%")
-        (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-               ((= USER::I 57295))
-            (CL:WHEN (CL:/= (CL:AREF CL:ARRAY USER::I)
-                            1)
-                   (CL:ERROR "Array of ones wasn't 1 at element ~D.~%" USER::I)))))
-
-
-
-(* |;;| "Assure that we compile with CL:COMPILE-FILE:")

-
-
-(PUTPROPS MAIKO-ARRAY-TESTS FILETYPE
 :COMPILE-FILE)
-(PUTPROPS MAIKO-ARRAY-TESTS COPYRIGHT (NONE))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (2440 3757 (MAIKO-ARRAY-TESTS 2450 . 3755)) (24775 29851 (SIMPLE-AREF-ASET-TESTS 24785
- . 29584) (NEQP 29586 . 29849)))))
-STOP

internal/test/Maiko/HAND/MAIKO-ARRAY-TESTS.~2~

@@ -1,514 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED " 4-Aug-88 18:06:52" {ERIS}<TEST>MAIKO>HAND>MAIKO-ARRAY-TESTS.\;9
 30433  
-
-      |changes| |to:|  (FUNCTIONS USER::POINTER-ARRAY-TESTS)
-
-      |previous| |date:| "22-Jun-88 13:52:22" {ERIS}<TEST>MAIKO>HAND>MAIKO-ARRAY-TESTS.\;8)
-
-
-(PRETTYCOMPRINT MAIKO-ARRAY-TESTSCOMS)
-
-(RPAQQ MAIKO-ARRAY-TESTSCOMS
 (
-                                  (* |;;| "Tests for AREF & ASET in Maiko")

-
-                                  
-                                  (* |;;| "TO DO:  Extendable arrays, Adjustable arrays, extend past 2**15 and make sure contents are still there.  Vectors, strings.")

-
-                                  
-                                  (* |;;| "Main test invokation function:")

-
-                                  (FNS MAIKO-ARRAY-TESTS)
-                                  
-                                  (* |;;| "1-dimensional array tests:")

-
-                                  (FUNCTIONS USER::BIT-ARRAY-TESTS USER::BYTE-ARRAY-TESTS 
-                                         USER::CHAR-ARRAY-TESTS USER::FLOAT-ARRAY-TESTS 
-                                         USER::POINTER-ARRAY-TESTS USER::XPOINTER-ARRAY-TESTS)
-                                  
-                                  (* |;;| "Simple AREF & ASET of 1-, 2-, 3-d # arrays:")

-
-                                  (FNS SIMPLE-AREF-ASET-TESTS NEQP)
-                                  
-                                  (* |;;| "Test of past known failures")

-
-                                  (FUNCTIONS USER::PAST-ARRAY-FAILURE-CASES)
-                                  
-                                  (* |;;| "Assure that we compile with CL:COMPILE-FILE:")

-
-                                  (PROPS (MAIKO-ARRAY-TESTS FILETYPE))))
-
-
-
-(* |;;| "Tests for AREF & ASET in Maiko")

-
-
-
-
-(* |;;| 
-"TO DO:  Extendable arrays, Adjustable arrays, extend past 2**15 and make sure contents are still there.  Vectors, strings."
-)

-
-
-
-
-(* |;;| "Main test invokation function:")

-
-(DEFINEQ
-
-(MAIKO-ARRAY-TESTS

-  (LAMBDA (LIMIT)
                                        (* \; "Edited 22-Jun-88 13:51 by jds")

-
-    (* |;;| "Main entry point to the Maiko array op-code tests.")

-
-    (|for|
 I |from|
 1 |to|
 LIMIT |do|
 (PRINTOUT T T 
-                                                    "Starting Maiko array op-code tests, iteration #"
-                                                             I T)
-                                                   (USER::BIT-ARRAY-TESTS 2)
-                                                   (USER::BYTE-ARRAY-TESTS 2)
-                                                   (USER::CHAR-ARRAY-TESTS 2)
-                                                   (USER::FLOAT-ARRAY-TESTS 2)
-                                                   (USER::POINTER-ARRAY-TESTS 2)
-                                                   (USER::XPOINTER-ARRAY-TESTS 2)
-                                                   (PRINTOUT T 
-                                                    "  Starting #-array aref/set tests for 1-3 dims."
-                                                          )
-                                                   (SIMPLE-AREF-ASET-TESTS
)
-                                                   (USER::PAST-ARRAY-FAILURE-CASES 1))))
-)
-
-
-
-(* |;;| "1-dimensional array tests:")

-
-
-(CL:DEFUN USER::BIT-ARRAY-TESTS
 (USER::LIMIT)
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting bit-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'BIT 
-                                                      :INITIAL-ELEMENT 0))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'BIT 
-                                                     :INITIAL-ELEMENT 1)))
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        0)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                        1)
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               (COND
-                                                  ((EVENP USER::I)
-                                                   1)
-                                                  (T 0)))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (COND
-                                                           ((EVENP USER::I)
-                                                            1)
-                                                           (T 0)))
-                                               (CL:ERROR "EVENP pattern fails at ~D.~%" USER::I))))))
-          ))
-
-(CL:DEFUN USER::BYTE-ARRAY-TESTS
 (USER::LIMIT)
-
-   (* |;;| "Tests of byte arrays, for bytes of length 1, 8, 16, and 32 bits.")

-
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting byte-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::BYTE-LEN IN
 '(1 8 16 32) AS
 USER::MAX-VALUE
-               IN
 '(2 256 65535 65535)
-               DO
 (CL:FORMAT T "    Byte length = ~D~%" USER::BYTE-LEN)
-                     (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-                        IN
 '(8 16 32 32767 65535)
-                        DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                                      (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE
-                                                               (LIST 'CL:UNSIGNED-BYTE USER::BYTE-LEN
-                                                                     )
-                                                               :INITIAL-ELEMENT 0))
-                                      (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE
-                                                              (LIST 'CL:UNSIGNED-BYTE USER::BYTE-LEN)
-                                                              :INITIAL-ELEMENT 1)))
-                                     (CL:FORMAT T "   Array size = ~D~%" USER::LEN)
-                                     (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                                    ((= USER::I USER::LEN))
-                                                 (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                                 0)
-                                                        (CL:ERROR 
-                                                          "**Zero-array wasn't zero at element ~d.~%"
-                                                               USER::I))
-                                                 (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                                 1)
-                                                        (CL:ERROR 
-                                                            "**One-array wasn't one at element ~d.~%"
-                                                               USER::I))))
-                                     (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                                    ((= USER::I USER::LEN))
-                                                 (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (CL:REM USER::I USER::MAX-VALUE))
-                                                 (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                                 (CL:REM USER::I USER::MAX-VALUE))
-                                                        (CL:ERROR "EVENP pattern fails at ~D.~%" 
-                                                               USER::I)))))))))
-
-(CL:DEFUN USER::CHAR-ARRAY-TESTS
 (USER::LIMIT)
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting bit-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'CL:CHARACTER 
-                                                      :INITIAL-ELEMENT #\D))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'CL:CHARACTER 
-                                                     :INITIAL-ELEMENT (CL:INT-CHAR (CHARCODE "41,133"
-                                                                                          )))))
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (NEQ (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                      #\D)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (NEQ (CL:AREF USER::ONE-ARRAY USER::I)
-                                                      (CL:INT-CHAR (CHARCODE "41,133")))
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))))))
-
-(CL:DEFUN USER::FLOAT-ARRAY-TESTS
 (USER::LIMIT)
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting FLOAT-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'FLOAT 
-                                                      :INITIAL-ELEMENT 0.0))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'FLOAT 
-                                                     :INITIAL-ELEMENT 1.0)))
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        0.0)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                        1.0)
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               (CL:SIN (CL:* USER::I (/ 3.1415927 USER::LEN))))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (CL:SIN (CL:* USER::I (/ 3.1415927 USER::LEN)
-                                                                      )))
-                                               (CL:ERROR "SIN pattern fails at ~D.~%" USER::I))))
-
-                            (* |;;| "Just create 1000 of floats into the array, and read them out, so we can run STORAGE later to see if they leaked.")

-
-                            (CL:DO ((USER::I 0 (CL:1+ USER::I))
-                                    (CL:ELT (RAND 0 (CL:1- USER::LEN))
-                                           (RAND 0 (CL:1- USER::LEN))))
-                                   ((= USER::I 1000))
-                                (CL:SETF (CL:AREF USER::ZERO-ARRAY CL:ELT)
-                                       (CL:SIN (CL:* USER::I (/ 3.1415927 USER::LEN))))
-                                (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY CL:ELT)
-                                                (CL:SIN (CL:* USER::I (/ 3.1415927 USER::LEN))))
-                                       (CL:ERROR "SIN pattern fails at ~D.~%" USER::I)))))))
-
-(CL:DEFUN USER::POINTER-ARRAY-TESTS
 (USER::LIMIT)
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting pointer-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :INITIAL-ELEMENT 0))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :INITIAL-ELEMENT 1))
-                             (USER::GC-ITEM (CREATE
 FMTSPEC))
-                             USER::OLD-REFCNT)
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        0)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                        1)
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               (COND
-                                                  ((EVENP USER::I)
-                                                   1)
-                                                  (T 0)))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (COND
-                                                           ((EVENP USER::I)
-                                                            1)
-                                                           (T 0)))
-                                               (CL:ERROR "EVENP pattern fails at ~D.~%" USER::I))))
-
-                            (* |;;| 
-
                "Make sure that putting a pointer to something into an array adds to the refcount.")

-
-                            (ERSETQ (CL:SETQ USER::OLD-REFCNT (\\REFCNT USER::GC-ITEM))
-                                   (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                          ((= USER::I USER::LEN))
-                                       (CL:SETQ USER::OLD-REFCNT (\\REFCNT USER::GC-ITEM))
-                                       (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                              USER::GC-ITEM)
-                                       (OR (EQ (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               USER::GC-ITEM)
-                                           (CL:ERROR 
-                                                  "Filling array with GC sample item failed at ~D.~%"
-                                                  USER::I))
-                                       (CL:WHEN (CL:/= (\\REFCNT USER::GC-ITEM)
-                                                       (CL:1+ USER::OLD-REFCNT))
-                                              (CL:ERROR "ASET doesn't bump ref-count at ~D.~%" 
-                                                     USER::I)))
-                                   (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                          ((= USER::I USER::LEN))
-                                       (CL:SETQ USER::OLD-REFCNT (\\REFCNT USER::GC-ITEM))
-                                       (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                              NIL)
-                                       (OR (NOT (CL:AREF USER::ZERO-ARRAY USER::I))
-                                           (CL:ERROR "Filling array with NIL failed at ~D.~%" USER::I
-                                                  ))
-                                       (CL:WHEN (CL:/= (\\REFCNT USER::GC-ITEM)
-                                                       (CL:1- USER::OLD-REFCNT))
-                                              (CL:ERROR 
-                                                   "ASET to NIL doesn't decrement ref-count at ~D.~%"
-                                                     USER::I))))))))
-
-(CL:DEFUN USER::XPOINTER-ARRAY-TESTS
 (USER::LIMIT)
-
-   (* |;;| "Tests of arrays of XPOINTERs.")

-
-   (FOR
 USER::LOOP-NO FROM
 1 TO
 USER::LIMIT
-      COLLECT
 (CL:FORMAT T "  Starting xpointer-array tests, iteration ~D~%" USER::LOOP-NO)
-            (FOR
 USER::MIN-LENGTH IN
 '(1 9 17 33 32768) AS
 USER::MAX-LENGTH
-               IN
 '(8 16 32 32767 65535)
-               DO
 (LET* ((USER::LEN (RAND USER::MIN-LENGTH USER::MAX-LENGTH))
-                             (USER::ZERO-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'XPOINTER 
-                                                      :INITIAL-ELEMENT 0))
-                             (USER::ONE-ARRAY (CL:MAKE-ARRAY USER::LEN :ELEMENT-TYPE 'XPOINTER 
-                                                     :INITIAL-ELEMENT 1))
-                             (USER::GC-ITEMS (LIST (CREATE
 FMTSPEC)
-                                                   100000 3.55 (CONS 3 4)
-                                                   (COMPLEX 3.4 5)
-                                                   4/5
-                                                   #'(CL:LAMBDA (USER::X)
-                                                            (CL:PRINT (USER::DATE USER::X)))
-                                                   (CL:MAKE-ARRAY 5)))
-                             USER::GC-ITEM USER::OLD-REFCNT)
-                            (CL:FORMAT T "    Array size = ~D~%" USER::LEN)
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        0)
-                                               (CL:ERROR "**Zero-array wasn't zero at element ~d.~%"
-                                                      USER::I))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ONE-ARRAY USER::I)
-                                                        1)
-                                               (CL:ERROR "**One-array wasn't one at element ~d.~%" 
-                                                      USER::I))))
-                            (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                           ((= USER::I USER::LEN))
-                                        (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                               (COND
-                                                  ((EVENP USER::I)
-                                                   1)
-                                                  (T 0)))
-                                        (CL:WHEN (CL:/= (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        (COND
-                                                           ((EVENP USER::I)
-                                                            1)
-                                                           (T 0)))
-                                               (CL:ERROR "EVENP pattern fails at ~D.~%" USER::I))))
-
-                            (* |;;| 
-
                "Make sure that putting a pointer to something into an array adds to the refcount.")

-
-                            (FOR
 USER::GC-ITEM IN
 USER::GC-ITEMS
-                               DO
 (CL:SETQ USER::OLD-REFCNT (\\REFCNT USER::GC-ITEM))
-                                     (ERSETQ (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                                    ((= USER::I USER::LEN))
-                                                 (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                        USER::GC-ITEM)
-                                                 (OR (EQ (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                         USER::GC-ITEM)
-                                                     (CL:ERROR 
-                                                  "Filling array with GC sample item failed at ~D.~%"
-                                                            USER::I))
-                                                 (CL:WHEN (CL:/= (\\REFCNT USER::GC-ITEM)
-                                                                 USER::OLD-REFCNT)
-                                                        (CL:ERROR "ASET bumps ref-count at ~D.~%" 
-                                                               USER::I)))
-                                            (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-                                                   ((= USER::I USER::LEN))
-                                                (CL:SETF (CL:AREF USER::ZERO-ARRAY USER::I)
-                                                       NIL)
-                                                (OR (NOT (CL:AREF USER::ZERO-ARRAY USER::I))
-                                                    (CL:ERROR 
-                                                           "Filling array with NIL failed at ~D.~%" 
-                                                           USER::I))
-                                                (CL:WHEN (CL:/= (\\REFCNT USER::GC-ITEM)
-                                                                USER::OLD-REFCNT)
-                                                       (CL:ERROR 
-                                                          "ASET to NIL decrements ref-count at ~D.~%"
-                                                              USER::I)))))))))
-
-
-
-(* |;;| "Simple AREF & ASET of 1-, 2-, 3-d # arrays:")

-
-(DEFINEQ
-
-(SIMPLE-AREF-ASET-TESTS

-  (LAMBDA NIL
                                            (* \; "Edited  9-Jun-88 19:02 by jds")

-
-    (* |;;| "Just run thru AREF and ASET on simple 1- 2- and 3-d arrays of numbers and make sure they look reasonable.")

-
-    (LET ((|array1d| (CL:MAKE-ARRAY '(10)
-                            :INITIAL-CONTENTS
-                            '(0 1 2 3 4 5 6 7 8 9)))
-          (|array2d| (CL:MAKE-ARRAY '(3 10)
-                            :INITIAL-CONTENTS
-                            '((0 1 2 3 4 5 6 7 8 9)
-                              (10 11 12 13 14 15 16 17 18 19)
-                              (20 21 22 23 24 25 26 27 28 29))))
-          (|array3d| (CL:MAKE-ARRAY '(2 3 10)
-                            :INITIAL-CONTENTS
-                            '(((0 1 2 3 4 5 6 7 8 9)
-                               (10 11 12 13 14 15 16 17 18 19)
-                               (20 21 22 23 24 25 26 27 28 29))
-                              ((100 101 102 103 104 105 106 107 108 109)
-                               (110 111 112 113 114 115 116 117 118 119)
-                               (120 121 122 123 124 125 126 127 128 129)))))
-          (|array1d-0| (CL:MAKE-ARRAY '(10)
-                              :INITIAL-ELEMENT "ASDF"))
-          (|array2d-0| (CL:MAKE-ARRAY '(3 10)
-                              :INITIAL-ELEMENT 3.5))
-          (|array3d-0| (CL:MAKE-ARRAY '(2 3 10)
-                              :INITIAL-ELEMENT
-                              '|array3d-0|)))
-
-         (* |;;| " 1 d array ref")

-
-         (|for|
 \i |from|
 0 |to|
 9 |do|
 (NEQP \i (CL:AREF |array1d| \i)
-                                                              '(CL:AREF |array1d| \i)))
-
-         (* |;;| " 2 d array ref")

-
-         (|for|
 \j |from|
 0 |to|
 2
-            |do|
 (|for|
 \i |from|
 0 |to|
 9
-                        |do|
 (NEQP (+ (TIMES \j 10)
-                                          \i)
-                                       (CL:AREF |array2d| \j \i)
-                                       '(CL:AREF |array2d| \j \i))))
-
-         (* |;;| "3 d aref")

-
-         (|for|
 \k |from|
 0 |to|
 1
-            |do|
 (|for|
 \j |from|
 0 |to|
 2
-                        |do|
 (|for|
 \i |from|
 0 |to|
 9
-                                    |do|
 (NEQP (+ (TIMES \k 100)
-                                                      (TIMES \j 10)
-                                                      \i)
-                                                   (CL:AREF |array3d| \k \j \i)
-                                                   '(CL:AREF |array3d| \k \j \i)))))
-
-         (* |;;| "1 d array set")

-
-         (|for|
 \i |from|
 0 |to|
 9 |do|
 (CL:SETF (CL:AREF |array1d-0| \i)
-                                                               (DIFFERENCE 10 \i)))
-
-         (* |;;| "1 d array ref")

-
-         (|for|
 \i |from|
 0 |to|
 9 |do|
 (NEQP (DIFFERENCE 10 \i)
-                                                              (CL:AREF |array1d-0| \i)
-                                                              '(CL:AREF |array1d-0| \i)))
-
-         (* |;;| "2 d array set")

-
-         (|for|
 \j |from|
 0 |to|
 2
-            |do|
 (|for|
 \i |from|
 0 |to|
 9
-                        |do|
 (CL:SETF (CL:AREF |array2d-0| \j \i)
-                                        (PLUS \j (TIMES \i 10)))))
-
-         (* |;;| "2 d aref")

-
-         (|for|
 \j |from|
 0 |to|
 2
-            |do|
 (|for|
 \i |from|
 0 |to|
 9
-                        |do|
 (NEQP (PLUS \j (TIMES \i 10))
-                                       (CL:AREF |array2d-0| \j \i)
-                                       '(CL:AREF |array2d-0| \j \i))))
-
-         (* |;;| " 3 d array set")

-
-         (|for|
 \k |from|
 0 |to|
 1
-            |do|
 (|for|
 \j |from|
 0 |to|
 2
-                        |do|
 (|for|
 \i |from|
 0 |to|
 9
-                                    |do|
 (CL:SETF (CL:AREF |array3d-0| \k \j \i)
-                                                    (PLUS \k (TIMES \j 10)
-                                                          (TIMES \i 100))))))
-
-         (* |;;| "3 d aref")

-
-         (|for|
 \k |from|
 0 |to|
 1
-            |do|
 (|for|
 \j |from|
 0 |to|
 2
-                        |do|
 (|for|
 \i |from|
 0 |to|
 9
-                                    |do|
 (NEQP (PLUS \k (TIMES \j 10)
-                                                         (TIMES \i 100))
-                                                   (CL:AREF |array3d-0| \k \j \i)
-                                                   '(CL:AREF |array3d-0| \k \j \i))))))))
-
-(NEQP

-  (LAMBDA (A B ERROR-MSG)
                            (* \; "Edited 12-Jun-88 18:13 by sybalsky")

-
-    (* |;;| "if  the two numbers A and B are not equal then halt with error message ERROR-MSG")

-
-    (OR (EQP A B)
-        (ERROR ERROR-MSG))))
-)
-
-
-
-(* |;;| "Test of past known failures")

-
-
-(CL:DEFUN USER::PAST-ARRAY-FAILURE-CASES
 (USER::LIMIT)
-
-   (* |;;| "Repository for past known failure cases, gleened from hand tests, ARs, and failed runs of this test suite.")

-
-   (CL:FORMAT T "  Starting test of past failure syndromes.~%")
-   (LET ((CL:ARRAY (CL:MAKE-ARRAY 57296 :ELEMENT-TYPE '(CL:UNSIGNED-BYTE 8)
-                          :INITIAL-ELEMENT 1)))
-        (CL:FORMAT T "   Test of array of 57296 (unsigned-byte 8)s inited to 1s.~%")
-        (CL:DO ((USER::I 0 (CL:1+ USER::I)))
-               ((= USER::I 57295))
-            (CL:WHEN (CL:/= (CL:AREF CL:ARRAY USER::I)
-                            1)
-                   (CL:ERROR "Array of ones wasn't 1 at element ~D.~%" USER::I)))))
-
-
-
-(* |;;| "Assure that we compile with CL:COMPILE-FILE:")

-
-
-(PUTPROPS MAIKO-ARRAY-TESTS FILETYPE
 :COMPILE-FILE)
-(PUTPROPS MAIKO-ARRAY-TESTS COPYRIGHT (NONE))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (2075 3392 (MAIKO-ARRAY-TESTS 2085 . 3390)) (24410 29486 (SIMPLE-AREF-ASET-TESTS 24420
- . 29219) (NEQP 29221 . 29484)))))
-STOP

internal/test/Maiko/STACKHAX

@@ -1,78 +1 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "15-Nov-88 17:16:48" {ERIS}<TEST>MAIKO>STACKHAX.\;4
 4101   
-
-      |changes| |to:|  (FNS CHECKSTACKSPACE)
-
-      |previous| |date:| "27-Oct-88 14:58:37" {ERIS}<TEST>MAIKO>STACKHAX.\;1)
-
-
-; Copyright (c) 1988 by I.  All rights reserved.
-
-(PRETTYCOMPRINT STACKHAXCOMS)
-
-(RPAQQ STACKHAXCOMS
 ((FNS CHECKSTACKSPACE)))
-(DEFINEQ
-
-(CHECKSTACKSPACE

-  (LAMBDA (START)
                                        (* \; "Edited 15-Nov-88 16:55 by jds")

-    (PROG ((SCANPTR (OR START (|fetch|
 |StackBase| |of|
 |\\InterfacePage|)))
-           (EASP (|fetch|
 |EndOfStack| |of|
 |\\InterfacePage|))
-           (*PRINT-LEVEL* 2)
-           (*PRINT-LENGTH* 2))
-      SCAN
-          (SELECTC (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-              (\\STK.FSB (CL:FORMAT T "~6o Free Block~%" SCANPTR)
-                         (COND
-                            ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                             (HELP "FSB size 0 at " SCANPTR)))
-                         (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR)))
-              (\\STK.GUARD (CL:FORMAT T "~6o Guard Block~%" SCANPTR)
-                           (COND
-                              ((EQ SCANPTR EASP)
-                               (RETURN T)))
-
-                           (* |;;| "Guard block not at end of stack, treat as a free block:")

-
-                           (COND
-                              ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                               (HELP "Guard block size 0 at " SCANPTR)))
-                           (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                                                             (* \; "reached end")

-                           )
-              (\\STK.FX                                      (* \; "frame extension")

-                        (CL:FORMAT T "~6o Frame Extn (use ~D) for ~S~%" SCANPTR (FETCH

-                                                                                 (FX USECNT)
-                                                                                   OF
 SCANPTR)
-                               (|fetch|
 (FNHEADER FRAMENAME) |of|
 (|fetch|
 (FX FNHEADER)
-                                                                             |of|
 SCANPTR)))
-                        (OR (|fetch|
 (FX CHECKED) |of|
 SCANPTR)
-                            (CL:FORMAT T "       FX not CHECKED at ~O.~%" SCANPTR))
-                        (COND
-                           ((EQUAL (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)
-                                   SCANPTR)
-                            (CL:FORMAT T "       FX's NEXTBLOCK points to itself at ~O.~%" SCANPTR)))
-                        (SETQ SCANPTR (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)))
-              (LET ((ORIG SCANPTR))                          (* \; "must be a basic frame")

-                   (|until|
 (|type?|
 BF SCANPTR)
-                      |do|
 (OR (EQ (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-                                       \\STK.NOTFLAG)
-                                   (CL:FORMAT T "       Non-zero flags in a non-BF word at ~O.~%" 
-                                          SCANPTR))
-                            (|add|
 SCANPTR WORDSPERCELL))
-                   (CL:FORMAT T "~6o Basic Frame~%" SCANPTR)
-                   (OR (COND
-                          ((|fetch|
 (BF RESIDUAL) |of|
 SCANPTR)
-                           (EQ SCANPTR ORIG))
-                          (T (AND (|fetch|
 (BF CHECKED) |of|
 SCANPTR)
-                                  (EQ ORIG (|fetch|
 (BF IVAR) |of|
 SCANPTR)))))
-                       (CL:FORMAT T "       Bad basic frame at ~O.~%" SCANPTR))
-                   (|add|
 SCANPTR WORDSPERCELL)))
-      NEXT
-          (OR (ILEQ SCANPTR EASP)
-              (HELP "SCANPTR got beyond EASP"))
-          (GO SCAN))))
-)
-(PUTPROPS STACKHAX COPYRIGHT ("I" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (402 4037 (CHECKSTACKSPACE 412 . 4035)))))
-STOP
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)

internal/test/Maiko/STACKHAX.~1~

@@ -1,62 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
-
(FILECREATED "27-Oct-88 14:58:37" {ERIS}<TEST>MAIKO>STACKHAX.\;1
 3191   )
-
-
-; Copyright (c) 1988 by I.  All rights reserved.
-
-(PRETTYCOMPRINT STACKHAXCOMS)
-
-(RPAQQ STACKHAXCOMS
 ((FNS CHECKSTACKSPACE)))
-(DEFINEQ
-
-(CHECKSTACKSPACE

-  (LAMBDA (N START)
                                      (* \; "Edited 27-Oct-88 14:51 by jds")

-    (PROG ((SCANPTR (|fetch|
 |StackBase| |of|
 |\\InterfacePage|))
-           (EASP (|fetch|
 |EndOfStack| |of|
 |\\InterfacePage|)))
-      SCAN
-          (SELECTC (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-              (\\STK.FSB (COND
-                            ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                             (HELP "FSB size 0 at " SCANPTR)))
-                         (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR)))
-              (\\STK.GUARD (COND
-                              ((EQ SCANPTR EASP)             (* \; 
-
                                           "Guard block not at end of stack, treat as a free block")

-                               (RETURN T)))
-                           (COND
-                              ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                               (HELP "Guard block size 0 at " SCANPTR)))
-                           (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                                                             (* \; "reached end")

-                           )
-              (\\STK.FX                                      (* \; "frame extension")

-                        (OR (|fetch|
 (FX CHECKED) |of|
 SCANPTR)
-                            (CL:WARN "FX not CHECKED at ~O." SCANPTR))
-                        (COND
-                           ((EQUAL (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)
-                                   SCANPTR)
-                            (CL:WARN "FX's NEXTBLOCK points to itself at ~O." SCANPTR)))
-                        (SETQ SCANPTR (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)))
-              (LET ((ORIG SCANPTR))                          (* \; "must be a basic frame")

-                   (|until|
 (|type?|
 BF SCANPTR)
-                      |do|
 (OR (EQ (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-                                       \\STK.NOTFLAG)
-                                   T
-                                   (CL:WARN "Non-zero flags in a non-BF word at ~O." SCANPTR))
-                            (|add|
 SCANPTR WORDSPERCELL))
-                   (OR (COND
-                          ((|fetch|
 (BF RESIDUAL) |of|
 SCANPTR)
-                           (EQ SCANPTR ORIG))
-                          (T (AND (|fetch|
 (BF CHECKED) |of|
 SCANPTR)
-                                  (EQ ORIG (|fetch|
 (BF IVAR) |of|
 SCANPTR)))))
-                       (CL:WARN "Bad basic frame at ~O." SCANPTR))
-                   (|add|
 SCANPTR WORDSPERCELL)))
-      NEXT
-          (OR (ILEQ SCANPTR EASP)
-              (HELP "SCANPTR got beyond EASP"))
-          (GO SCAN))))
-)
-(PUTPROPS STACKHAX COPYRIGHT ("I" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (269 3127 (CHECKSTACKSPACE 279 . 3125)))))
-STOP

internal/test/Maiko/STACKHAX.~2~

@@ -1,77 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "15-Nov-88 16:42:40" {ERIS}<TEST>MAIKO>STACKHAX.\;2
 4157   
-
-      |changes| |to:|  (FNS CHECKSTACKSPACE)
-
-      |previous| |date:| "27-Oct-88 14:58:37" {ERIS}<TEST>MAIKO>STACKHAX.\;1)
-
-
-; Copyright (c) 1988 by I.  All rights reserved.
-
-(PRETTYCOMPRINT STACKHAXCOMS)
-
-(RPAQQ STACKHAXCOMS
 ((FNS CHECKSTACKSPACE)))
-(DEFINEQ
-
-(CHECKSTACKSPACE

-  (LAMBDA (N START)
                                      (* \; "Edited 15-Nov-88 16:25 by jds")

-    (PROG ((SCANPTR (|fetch|
 |StackBase| |of|
 |\\InterfacePage|))
-           (EASP (|fetch|
 |EndOfStack| |of|
 |\\InterfacePage|))
-           (*PRINT-LEVEL* 2)
-           (*PRINT-LENGTH* 2))
-      SCAN
-          (SELECTC (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-              (\\STK.FSB (CL:FORMAT T "~6o Free Block~%" SCANPTR)
-                         (COND
-                            ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                             (HELP "FSB size 0 at " SCANPTR)))
-                         (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR)))
-              (\\STK.GUARD (CL:FORMAT T "~6o Guard Block~%" SCANPTR)
-                           (COND
-                              ((EQ SCANPTR EASP)             (* \; 
-
                                           "Guard block not at end of stack, treat as a free block")

-                               (RETURN T)))
-                           (COND
-                              ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                               (HELP "Guard block size 0 at " SCANPTR)))
-                           (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                                                             (* \; "reached end")

-                           )
-              (\\STK.FX                                      (* \; "frame extension")

-                        (CL:FORMAT T "~6o Frame Extn for ~S~%" SCANPTR (FETCH
 (FNHEADER FRAMENAME
-                                                                                         )
-                                                                          OF
 (FETCH

-                                                                                  (FX FNHEADER)
-                                                                                    OF
 SCANPTR)))
-                        (OR (|fetch|
 (FX CHECKED) |of|
 SCANPTR)
-                            (CL:FORMAT T "       FX not CHECKED at ~O." SCANPTR))
-                        (COND
-                           ((EQUAL (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)
-                                   SCANPTR)
-                            (CL:FORMAT T "       FX's NEXTBLOCK points to itself at ~O." SCANPTR)))
-                        (SETQ SCANPTR (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)))
-              (LET ((ORIG SCANPTR))                          (* \; "must be a basic frame")

-                   (|until|
 (|type?|
 BF SCANPTR)
-                      |do|
 (OR (EQ (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-                                       \\STK.NOTFLAG)
-                                   T
-                                   (CL:FORMAT T "       Non-zero flags in a non-BF word at ~O." 
-                                          SCANPTR))
-                            (|add|
 SCANPTR WORDSPERCELL))
-                   (CL:FORMAT T "~6o Basic Frame~%" SCANPTR)
-                   (OR (COND
-                          ((|fetch|
 (BF RESIDUAL) |of|
 SCANPTR)
-                           (EQ SCANPTR ORIG))
-                          (T (AND (|fetch|
 (BF CHECKED) |of|
 SCANPTR)
-                                  (EQ ORIG (|fetch|
 (BF IVAR) |of|
 SCANPTR)))))
-                       (CL:WARN CL:FORMAT T "       Bad basic frame at ~O." SCANPTR))
-                   (|add|
 SCANPTR WORDSPERCELL)))
-      NEXT
-          (OR (ILEQ SCANPTR EASP)
-              (HELP "SCANPTR got beyond EASP"))
-          (GO SCAN))))
-)
-(PUTPROPS STACKHAX COPYRIGHT ("I" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (402 4093 (CHECKSTACKSPACE 412 . 4091)))))
-STOP

internal/test/Maiko/STACKHAX.~3~

@@ -1,78 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "15-Nov-88 16:51:34" {ERIS}<TEST>MAIKO>STACKHAX.\;3
 4103   
-
-      |changes| |to:|  (FNS CHECKSTACKSPACE)
-
-      |previous| |date:| "27-Oct-88 14:58:37" {ERIS}<TEST>MAIKO>STACKHAX.\;1)
-
-
-; Copyright (c) 1988 by I.  All rights reserved.
-
-(PRETTYCOMPRINT STACKHAXCOMS)
-
-(RPAQQ STACKHAXCOMS
 ((FNS CHECKSTACKSPACE)))
-(DEFINEQ
-
-(CHECKSTACKSPACE

-  (LAMBDA (START)
                                        (* \; "Edited 15-Nov-88 16:51 by jds")

-    (PROG ((SCANPTR (OR START (|fetch|
 |StackBase| |of|
 |\\InterfacePage|)))
-           (EASP (|fetch|
 |EndOfStack| |of|
 |\\InterfacePage|))
-           (*PRINT-LEVEL* 2)
-           (*PRINT-LENGTH* 2))
-      SCAN
-          (SELECTC (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-              (\\STK.FSB (CL:FORMAT T "~6o Free Block~%" SCANPTR)
-                         (COND
-                            ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                             (HELP "FSB size 0 at " SCANPTR)))
-                         (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR)))
-              (\\STK.GUARD (CL:FORMAT T "~6o Guard Block~%" SCANPTR)
-                           (COND
-                              ((EQ SCANPTR EASP)
-                               (RETURN T)))
-
-                           (* |;;| "Guard block not at end of stack, treat as a free block:")

-
-                           (COND
-                              ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                               (HELP "Guard block size 0 at " SCANPTR)))
-                           (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                                                             (* \; "reached end")

-                           )
-              (\\STK.FX                                      (* \; "frame extension")

-                        (CL:FORMAT T "~6o Frame Extn for ~S~%" SCANPTR (FETCH
 (FNHEADER FRAMENAME
-                                                                                         )
-                                                                          OF
 (FETCH

-                                                                                  (FX FNHEADER)
-                                                                                    OF
 SCANPTR)))
-                        (OR (|fetch|
 (FX CHECKED) |of|
 SCANPTR)
-                            (CL:FORMAT T "       FX not CHECKED at ~O.~%" SCANPTR))
-                        (COND
-                           ((EQUAL (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)
-                                   SCANPTR)
-                            (CL:FORMAT T "       FX's NEXTBLOCK points to itself at ~O.~%" SCANPTR)))
-                        (SETQ SCANPTR (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)))
-              (LET ((ORIG SCANPTR))                          (* \; "must be a basic frame")

-                   (|until|
 (|type?|
 BF SCANPTR)
-                      |do|
 (OR (EQ (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-                                       \\STK.NOTFLAG)
-                                   (CL:FORMAT T "       Non-zero flags in a non-BF word at ~O.~%" 
-                                          SCANPTR))
-                            (|add|
 SCANPTR WORDSPERCELL))
-                   (CL:FORMAT T "~6o Basic Frame~%" SCANPTR)
-                   (OR (COND
-                          ((|fetch|
 (BF RESIDUAL) |of|
 SCANPTR)
-                           (EQ SCANPTR ORIG))
-                          (T (AND (|fetch|
 (BF CHECKED) |of|
 SCANPTR)
-                                  (EQ ORIG (|fetch|
 (BF IVAR) |of|
 SCANPTR)))))
-                       (CL:FORMAT T "       Bad basic frame at ~O.~%" SCANPTR))
-                   (|add|
 SCANPTR WORDSPERCELL)))
-      NEXT
-          (OR (ILEQ SCANPTR EASP)
-              (HELP "SCANPTR got beyond EASP"))
-          (GO SCAN))))
-)
-(PUTPROPS STACKHAX COPYRIGHT ("I" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (402 4039 (CHECKSTACKSPACE 412 . 4037)))))
-STOP

internal/test/Maiko/STACKHAX.~4~

@@ -1,78 +0,0 @@
-(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
-
(FILECREATED "15-Nov-88 17:16:48" {ERIS}<TEST>MAIKO>STACKHAX.\;4
 4101   
-
-      |changes| |to:|  (FNS CHECKSTACKSPACE)
-
-      |previous| |date:| "27-Oct-88 14:58:37" {ERIS}<TEST>MAIKO>STACKHAX.\;1)
-
-
-; Copyright (c) 1988 by I.  All rights reserved.
-
-(PRETTYCOMPRINT STACKHAXCOMS)
-
-(RPAQQ STACKHAXCOMS
 ((FNS CHECKSTACKSPACE)))
-(DEFINEQ
-
-(CHECKSTACKSPACE

-  (LAMBDA (START)
                                        (* \; "Edited 15-Nov-88 16:55 by jds")

-    (PROG ((SCANPTR (OR START (|fetch|
 |StackBase| |of|
 |\\InterfacePage|)))
-           (EASP (|fetch|
 |EndOfStack| |of|
 |\\InterfacePage|))
-           (*PRINT-LEVEL* 2)
-           (*PRINT-LENGTH* 2))
-      SCAN
-          (SELECTC (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-              (\\STK.FSB (CL:FORMAT T "~6o Free Block~%" SCANPTR)
-                         (COND
-                            ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                             (HELP "FSB size 0 at " SCANPTR)))
-                         (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR)))
-              (\\STK.GUARD (CL:FORMAT T "~6o Guard Block~%" SCANPTR)
-                           (COND
-                              ((EQ SCANPTR EASP)
-                               (RETURN T)))
-
-                           (* |;;| "Guard block not at end of stack, treat as a free block:")

-
-                           (COND
-                              ((ZEROP (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                               (HELP "Guard block size 0 at " SCANPTR)))
-                           (|add|
 SCANPTR (|fetch|
 (FSB SIZE) |of|
 SCANPTR))
-                                                             (* \; "reached end")

-                           )
-              (\\STK.FX                                      (* \; "frame extension")

-                        (CL:FORMAT T "~6o Frame Extn (use ~D) for ~S~%" SCANPTR (FETCH

-                                                                                 (FX USECNT)
-                                                                                   OF
 SCANPTR)
-                               (|fetch|
 (FNHEADER FRAMENAME) |of|
 (|fetch|
 (FX FNHEADER)
-                                                                             |of|
 SCANPTR)))
-                        (OR (|fetch|
 (FX CHECKED) |of|
 SCANPTR)
-                            (CL:FORMAT T "       FX not CHECKED at ~O.~%" SCANPTR))
-                        (COND
-                           ((EQUAL (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)
-                                   SCANPTR)
-                            (CL:FORMAT T "       FX's NEXTBLOCK points to itself at ~O.~%" SCANPTR)))
-                        (SETQ SCANPTR (|fetch|
 (FX NEXTBLOCK) |of|
 SCANPTR)))
-              (LET ((ORIG SCANPTR))                          (* \; "must be a basic frame")

-                   (|until|
 (|type?|
 BF SCANPTR)
-                      |do|
 (OR (EQ (|fetch|
 (STK FLAGS) |of|
 SCANPTR)
-                                       \\STK.NOTFLAG)
-                                   (CL:FORMAT T "       Non-zero flags in a non-BF word at ~O.~%" 
-                                          SCANPTR))
-                            (|add|
 SCANPTR WORDSPERCELL))
-                   (CL:FORMAT T "~6o Basic Frame~%" SCANPTR)
-                   (OR (COND
-                          ((|fetch|
 (BF RESIDUAL) |of|
 SCANPTR)
-                           (EQ SCANPTR ORIG))
-                          (T (AND (|fetch|
 (BF CHECKED) |of|
 SCANPTR)
-                                  (EQ ORIG (|fetch|
 (BF IVAR) |of|
 SCANPTR)))))
-                       (CL:FORMAT T "       Bad basic frame at ~O.~%" SCANPTR))
-                   (|add|
 SCANPTR WORDSPERCELL)))
-      NEXT
-          (OR (ILEQ SCANPTR EASP)
-              (HELP "SCANPTR got beyond EASP"))
-          (GO SCAN))))
-)
-(PUTPROPS STACKHAX COPYRIGHT ("I" 1988))
-(DECLARE\: DONTCOPY
-  (FILEMAP (NIL (402 4037 (CHECKSTACKSPACE 412 . 4035)))))
-STOP

loadups/xlisp.dribble.~59~

@@ -1,184 +0,0 @@
-
-Synchronizing Lisp sysout at 23-Oct-2020 23:55:43 while connected to 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>
-     {DSK}<Users>kaplan>Local>medley3.5>lispcore>makesysout>SYNCLISPFILES.;48
-     created 23-Oct-2020 23:51:41
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FASLOAD.DFASL;1
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FASLOAD.;2
-Source file created Tuesday, 17 April 2018, 7:55:20.
-FASL file created Tuesday, 17 April 2018, 8:09:14.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FONT.LCOM;6
-compiled on 28-Jun-99 16:29:55
-File created 28-Jun-99 16:29:49
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>UFSCALLC.LCOM;3
-compiled on 18-May-2018 12:53:18
-File created 18-May-2018 12:53:00
-UFSCALLCCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>UFS.LCOM;3
-compiled on 18-May-2018 09:20:25
-File created 31-Dec-2000 12:38:40
-UFSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>APRINT.LCOM;2
-compiled on 17-Jan-2020 05:51:20
-File created 17-Jan-2020 05:51:20
-APRINTCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PMAP.LCOM;3
-compiled on 18-May-2018 09:21:40
-File created  3-Feb-2002 14:11:02
-PMAPCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ADIR.LCOM;7
-compiled on 14-Oct-2020 11:14:41
-File created 14-Oct-2020 11:14:03
-ADIRCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.LCOM;2
-compiled on  4-Oct-2018 14:13:06
-File created  4-Oct-2018 14:13:06
-COREIOCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ACODE.LCOM;6
-compiled on 25-Jun-2017 22:38:30
-File created 25-Jun-2017 22:35:00
-ACODECOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>IOCHAR.LCOM;10
-compiled on 10-Aug-2020 21:44:38
-File created 10-Aug-2020 21:44:38
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LLDATATYPE.LCOM;1
-compiled on 28-Jun-99 16:57:53
-File created 28-Jun-99 16:57:50
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LLCHAR.LCOM;2
-compiled on 11-Nov-2018 13:08:05
-File created 11-Nov-2018 13:08:04
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEIO.LCOM;12
-compiled on 13-Aug-2020 11:43:08
-File created 13-Aug-2020 11:43:08
-FILEIOCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PRETTY.LCOM;6
-compiled on 16-Apr-2018 21:37:10
-File created 16-Apr-2018 21:37:09
-PRETTYCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>NEWPRINTDEF.LCOM;2
-compiled on 31-Dec-2000 11:53:35
-File created 31-Dec-2000 11:53:33
-NEWPRINTDEFCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FONTPROFILE.LCOM;2
-compiled on 14-May-2018 00:04:35
-File created 28-Jun-99 22:10:46
-FONTPROFILECOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PRINTFN.LCOM;4
-compiled on 16-Apr-2018 21:40:32
-File created 16-Apr-2018 21:40:32
-PRINTFNCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LOADFNS.LCOM;10
-compiled on 16-Apr-2018 17:38:16
-File created 16-Apr-2018 17:38:16
-LOADFNSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.LCOM;12
-compiled on 10-Aug-2020 21:24:59
-File created 10-Aug-2020 21:24:58
-FILEPKGCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ASKUSER.LCOM;5
-compiled on 10-Aug-2020 21:18:50
-File created 10-Aug-2020 21:18:50
-ASKUSERCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>CMLMODULES.DFASL;4
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>CMLMODULES.;2
-Source file created Monday, 16 April 2018, 22:46:19.
-FASL file created Monday, 16 April 2018, 22:46:19.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LOGOW.DFASL;1
-XCL Compiler output for source file {DSK}<tilde>sybalsky>lispcore>sources>LOGOW.;2
-Source file created Sunday, 9 April 2000, 18:08:24.
-FASL file created Sunday, 9 April 2000, 18:08:25.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>DEXEC.LCOM;12
-compiled on 13-Aug-2020 12:36:18
-File created 13-Aug-2020 12:36:18
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>INSPECT.LCOM;7
-compiled on 21-Apr-2018 08:08:07
-File created 21-Apr-2018 08:08:07
-INSPECTCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>TWODINSPECTOR.LCOM;2
-compiled on 11-Aug-2020 11:22:31
-File created 11-Aug-2020 11:22:30
-TWODINSPECTORCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.DFASL;9
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;10
-Source file created 19-Sep-2020 22:02:59
-FASL file created Saturday, 19 September 2020, 22:02:59
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>HARDCOPY.LCOM;6
-compiled on 16-Apr-2018 22:15:08
-File created 16-Apr-2018 22:15:08
-HARDCOPYCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>INTERPRESS.LCOM;6
-compiled on 16-Apr-2018 21:56:38
-File created 16-Apr-2018 21:56:38
-INTERPRESSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.DFASL;3
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.;3
-Source file created Monday, 23 April 2018, 18:12:52.
-FASL file created Monday, 23 April 2018, 18:13:51.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.DFASL;2
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;2
-Source file created Monday, 14 May 2018, 14:12:02.
-FASL file created Monday, 14 May 2018, 14:12:02.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>TIME.LCOM;4
-compiled on 16-Apr-2018 23:05:17
-File created 16-Apr-2018 23:05:10
-
-
-30 files loaded
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>LLREADPATCH.LCOM;5
-compiled on  1-Aug-2020 18:52:48
-File created  1-Aug-2020 18:52:48
-LLREADPATCHCOMS
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>MACHINEINDEPENDENTPATCH.LCOM;2
-compiled on 19-Sep-2020 21:18:45
-File created 19-Sep-2020 20:56:09
-MACHINEINDEPENDENTPATCHCOMS
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>NOXNSPATCH.LCOM;1
-compiled on 31-Mar-99 17:08:42
-File created 31-Mar-99 17:08:40
-NOXNSPATCHCOMS
-
-
-3 files loaded
-Creating updated LISP sysout on 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>loadups>xlisp.sysout;1

loadups/xlisp.dribble.~61~

@@ -1,184 +0,0 @@
-
-Synchronizing Lisp sysout at 27-Oct-2020 15:42:46 while connected to 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>
-     {DSK}<Users>kaplan>Local>medley3.5>lispcore>makesysout>SYNCLISPFILES.;48
-     created 23-Oct-2020 23:51:41
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FASLOAD.DFASL;1
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FASLOAD.;2
-Source file created Tuesday, 17 April 2018, 7:55:20.
-FASL file created Tuesday, 17 April 2018, 8:09:14.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FONT.LCOM;6
-compiled on 28-Jun-99 16:29:55
-File created 28-Jun-99 16:29:49
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>UFSCALLC.LCOM;3
-compiled on 18-May-2018 12:53:18
-File created 18-May-2018 12:53:00
-UFSCALLCCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>UFS.LCOM;3
-compiled on 18-May-2018 09:20:25
-File created 31-Dec-2000 12:38:40
-UFSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>APRINT.LCOM;2
-compiled on 17-Jan-2020 05:51:20
-File created 17-Jan-2020 05:51:20
-APRINTCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PMAP.LCOM;3
-compiled on 18-May-2018 09:21:40
-File created  3-Feb-2002 14:11:02
-PMAPCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ADIR.LCOM;7
-compiled on 14-Oct-2020 11:14:41
-File created 14-Oct-2020 11:14:03
-ADIRCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.LCOM;2
-compiled on  4-Oct-2018 14:13:06
-File created  4-Oct-2018 14:13:06
-COREIOCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ACODE.LCOM;6
-compiled on 25-Jun-2017 22:38:30
-File created 25-Jun-2017 22:35:00
-ACODECOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>IOCHAR.LCOM;10
-compiled on 10-Aug-2020 21:44:38
-File created 10-Aug-2020 21:44:38
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LLDATATYPE.LCOM;1
-compiled on 28-Jun-99 16:57:53
-File created 28-Jun-99 16:57:50
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LLCHAR.LCOM;2
-compiled on 11-Nov-2018 13:08:05
-File created 11-Nov-2018 13:08:04
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEIO.LCOM;12
-compiled on 13-Aug-2020 11:43:08
-File created 13-Aug-2020 11:43:08
-FILEIOCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PRETTY.LCOM;6
-compiled on 16-Apr-2018 21:37:10
-File created 16-Apr-2018 21:37:09
-PRETTYCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>NEWPRINTDEF.LCOM;2
-compiled on 31-Dec-2000 11:53:35
-File created 31-Dec-2000 11:53:33
-NEWPRINTDEFCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FONTPROFILE.LCOM;2
-compiled on 14-May-2018 00:04:35
-File created 28-Jun-99 22:10:46
-FONTPROFILECOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PRINTFN.LCOM;4
-compiled on 16-Apr-2018 21:40:32
-File created 16-Apr-2018 21:40:32
-PRINTFNCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LOADFNS.LCOM;10
-compiled on 16-Apr-2018 17:38:16
-File created 16-Apr-2018 17:38:16
-LOADFNSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.LCOM;13
-compiled on 27-Oct-2020 15:40:33
-File created 27-Oct-2020 15:40:32
-FILEPKGCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ASKUSER.LCOM;5
-compiled on 10-Aug-2020 21:18:50
-File created 10-Aug-2020 21:18:50
-ASKUSERCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>CMLMODULES.DFASL;4
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>CMLMODULES.;2
-Source file created Monday, 16 April 2018, 22:46:19.
-FASL file created Monday, 16 April 2018, 22:46:19.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LOGOW.DFASL;1
-XCL Compiler output for source file {DSK}<tilde>sybalsky>lispcore>sources>LOGOW.;2
-Source file created Sunday, 9 April 2000, 18:08:24.
-FASL file created Sunday, 9 April 2000, 18:08:25.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>DEXEC.LCOM;12
-compiled on 13-Aug-2020 12:36:18
-File created 13-Aug-2020 12:36:18
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>INSPECT.LCOM;7
-compiled on 21-Apr-2018 08:08:07
-File created 21-Apr-2018 08:08:07
-INSPECTCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>TWODINSPECTOR.LCOM;2
-compiled on 11-Aug-2020 11:22:31
-File created 11-Aug-2020 11:22:30
-TWODINSPECTORCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.DFASL;9
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;10
-Source file created 19-Sep-2020 22:02:59
-FASL file created Saturday, 19 September 2020, 22:02:59
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>HARDCOPY.LCOM;6
-compiled on 16-Apr-2018 22:15:08
-File created 16-Apr-2018 22:15:08
-HARDCOPYCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>INTERPRESS.LCOM;6
-compiled on 16-Apr-2018 21:56:38
-File created 16-Apr-2018 21:56:38
-INTERPRESSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.DFASL;3
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.;3
-Source file created Monday, 23 April 2018, 18:12:52.
-FASL file created Monday, 23 April 2018, 18:13:51.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.DFASL;2
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;2
-Source file created Monday, 14 May 2018, 14:12:02.
-FASL file created Monday, 14 May 2018, 14:12:02.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>TIME.LCOM;4
-compiled on 16-Apr-2018 23:05:17
-File created 16-Apr-2018 23:05:10
-
-
-30 files loaded
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>LLREADPATCH.LCOM;5
-compiled on  1-Aug-2020 18:52:48
-File created  1-Aug-2020 18:52:48
-LLREADPATCHCOMS
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>MACHINEINDEPENDENTPATCH.LCOM;2
-compiled on 19-Sep-2020 21:18:45
-File created 19-Sep-2020 20:56:09
-MACHINEINDEPENDENTPATCHCOMS
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>NOXNSPATCH.LCOM;1
-compiled on 31-Mar-99 17:08:42
-File created 31-Mar-99 17:08:40
-NOXNSPATCHCOMS
-
-
-3 files loaded
-Creating updated LISP sysout on 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>loadups>xlisp.sysout;2

loadups/xlisp.dribble.~62~

@@ -1,184 +0,0 @@
-
-Synchronizing Lisp sysout at 20-Nov-2020 23:12:24 while connected to 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>
-     {DSK}<Users>kaplan>Local>medley3.5>lispcore>makesysout>SYNCLISPFILES.;48
-     created 23-Oct-2020 23:51:41
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FASLOAD.DFASL;1
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FASLOAD.;2
-Source file created Tuesday, 17 April 2018, 7:55:20.
-FASL file created Tuesday, 17 April 2018, 8:09:14.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FONT.LCOM;6
-compiled on 28-Jun-99 16:29:55
-File created 28-Jun-99 16:29:49
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>UFSCALLC.LCOM;3
-compiled on 18-May-2018 12:53:18
-File created 18-May-2018 12:53:00
-UFSCALLCCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>UFS.LCOM;3
-compiled on 18-May-2018 09:20:25
-File created 31-Dec-2000 12:38:40
-UFSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>APRINT.LCOM;2
-compiled on 17-Jan-2020 05:51:20
-File created 17-Jan-2020 05:51:20
-APRINTCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PMAP.LCOM;3
-compiled on 18-May-2018 09:21:40
-File created  3-Feb-2002 14:11:02
-PMAPCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ADIR.LCOM;7
-compiled on 14-Oct-2020 11:14:41
-File created 14-Oct-2020 11:14:03
-ADIRCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>COREIO.LCOM;2
-compiled on  4-Oct-2018 14:13:06
-File created  4-Oct-2018 14:13:06
-COREIOCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ACODE.LCOM;6
-compiled on 25-Jun-2017 22:38:30
-File created 25-Jun-2017 22:35:00
-ACODECOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>IOCHAR.LCOM;10
-compiled on 10-Aug-2020 21:44:38
-File created 10-Aug-2020 21:44:38
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LLDATATYPE.LCOM;1
-compiled on 28-Jun-99 16:57:53
-File created 28-Jun-99 16:57:50
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LLCHAR.LCOM;2
-compiled on 11-Nov-2018 13:08:05
-File created 11-Nov-2018 13:08:04
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEIO.LCOM;12
-compiled on 13-Aug-2020 11:43:08
-File created 13-Aug-2020 11:43:08
-FILEIOCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PRETTY.LCOM;6
-compiled on 16-Apr-2018 21:37:10
-File created 16-Apr-2018 21:37:09
-PRETTYCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>NEWPRINTDEF.LCOM;2
-compiled on 31-Dec-2000 11:53:35
-File created 31-Dec-2000 11:53:33
-NEWPRINTDEFCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FONTPROFILE.LCOM;2
-compiled on 14-May-2018 00:04:35
-File created 28-Jun-99 22:10:46
-FONTPROFILECOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>PRINTFN.LCOM;4
-compiled on 16-Apr-2018 21:40:32
-File created 16-Apr-2018 21:40:32
-PRINTFNCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LOADFNS.LCOM;10
-compiled on 16-Apr-2018 17:38:16
-File created 16-Apr-2018 17:38:16
-LOADFNSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>FILEPKG.LCOM;13
-compiled on 27-Oct-2020 15:40:33
-File created 27-Oct-2020 15:40:32
-FILEPKGCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>ASKUSER.LCOM;5
-compiled on 10-Aug-2020 21:18:50
-File created 10-Aug-2020 21:18:50
-ASKUSERCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>CMLMODULES.DFASL;4
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>CMLMODULES.;2
-Source file created Monday, 16 April 2018, 22:46:19.
-FASL file created Monday, 16 April 2018, 22:46:19.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>LOGOW.DFASL;1
-XCL Compiler output for source file {DSK}<tilde>sybalsky>lispcore>sources>LOGOW.;2
-Source file created Sunday, 9 April 2000, 18:08:24.
-FASL file created Sunday, 9 April 2000, 18:08:25.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>DEXEC.LCOM;12
-compiled on 13-Aug-2020 12:36:18
-File created 13-Aug-2020 12:36:18
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>INSPECT.LCOM;7
-compiled on 21-Apr-2018 08:08:07
-File created 21-Apr-2018 08:08:07
-INSPECTCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>TWODINSPECTOR.LCOM;2
-compiled on 11-Aug-2020 11:22:31
-File created 11-Aug-2020 11:22:30
-TWODINSPECTORCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.DFASL;9
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>XCLC-TOP-LEVEL.;10
-Source file created 19-Sep-2020 22:02:59
-FASL file created Saturday, 19 September 2020, 22:02:59
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>HARDCOPY.LCOM;6
-compiled on 16-Apr-2018 22:15:08
-File created 16-Apr-2018 22:15:08
-HARDCOPYCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>INTERPRESS.LCOM;6
-compiled on 16-Apr-2018 21:56:38
-File created 16-Apr-2018 21:56:38
-INTERPRESSCOMS
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.DFASL;3
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-COMMANDS.;3
-Source file created Monday, 23 April 2018, 18:12:52.
-FASL file created Monday, 23 April 2018, 18:13:51.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.DFASL;2
-XCL Compiler output for source file {DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>SEDIT-WINDOW.;2
-Source file created Monday, 14 May 2018, 14:12:02.
-FASL file created Monday, 14 May 2018, 14:12:02.
-
-
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>sources>TIME.LCOM;4
-compiled on 16-Apr-2018 23:05:17
-File created 16-Apr-2018 23:05:10
-
-
-30 files loaded
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>LLREADPATCH.LCOM;5
-compiled on  1-Aug-2020 18:52:48
-File created  1-Aug-2020 18:52:48
-LLREADPATCHCOMS
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>MACHINEINDEPENDENTPATCH.LCOM;2
-compiled on 19-Sep-2020 21:18:45
-File created 19-Sep-2020 20:56:09
-MACHINEINDEPENDENTPATCHCOMS
-
-{DSK}<USERS>KAPLAN>LOCAL>MEDLEY3.5>LISPCORE>PATCHES>NOXNSPATCH.LCOM;1
-compiled on 31-Mar-99 17:08:42
-File created 31-Mar-99 17:08:40
-NOXNSPATCHCOMS
-
-
-3 files loaded
-Creating updated LISP sysout on 
-{DSK}<Users>kaplan>Local>medley3.5>lispcore>loadups>xlisp.sysout;3