(FILECREATED " 7-Jul-85 12:18:31" {ERIS}<LISPCORE>LIBRARY>MACROTEST.;10 116605Q
changes to: (VARS MACROTESTCOMS)
(FNS !GCTEST !GCTEST1 !GCTEST2 !DIAGNOSE)
previous date: "16-Dec-84 21:06:29" {ERIS}<LISPCORE>LIBRARY>MACROTEST.;9)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MACROTESTCOMS)
(RPAQQ MACROTESTCOMS ((E (RADIX 8))
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS MTHELP MTCHECKSTK CKEQ CKFEQ CKFUZZYEQ
MTCHECK MTCHECK1))
(FNS !DIAGNOSE !DIAGNOSELP)
(* "Basic entries")
(INITVARS (ERRORMESSAGESTREAM T)
(!MTALLOWINEXACTFLG T)
(!MTUSERAIDFLG T))
(FNS !CKEQ !CKFEQ !CKFUZZYEQ !MRAID)
(* "Utility fns")
(FNS !CONSTEST !COPY !SMASH !APPENDTEST)
(FNS !INTERPTEST !CHECKARGS !CHECKLSTARARG !CHECKLSTARSETARG)
(* "CONS and RPLAC tests")
(FNS !GCTEST !GCTEST1 !GCTEST2 !GCTESTSETF !GCTESTSETG)
(* "Test of garbage collector")
(FNS MINILOGOUT)
(* "File MACROTESTAUX contains freevar and numeric tests")
(DECLARE: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY (FILES MACROTESTAUX))))
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS MTHELP MACRO (X (LIST (QUOTE !MRAID)
(COND ((CDR X)
(CONS (QUOTE LIST)
X))
(T (CAR X]
[PUTPROPS MTCHECKSTK MACRO (ARGS (SUBPAIR (QUOTE (ARGS ID))
(LIST ARGS (RAND 1 MAX.SMALLP))
(QUOTE (OR (EQ (PROG1 ID . ARGS)
ID)
(RAID (QUOTE WRONG#PUSHED]
(PUTPROPS CKEQ MACRO ((FORM ANSWER)
([LAMBDA (Password Result)
(DECLARE (LOCALVARS Password Result))
(OR (EQ Password (QUOTE 343Q))
(RAID (QUOTE WRONG#PUSHED)))
(!CKEQ Result ANSWER (QUOTE FORM]
(QUOTE 343Q)
FORM)))
(PUTPROPS CKFEQ MACRO ((FORM ANSWER)
([LAMBDA (Password Result)
(DECLARE (LOCALVARS Password Result))
(OR (EQ Password (QUOTE 343Q))
(RAID (QUOTE WRONG#PUSHED)))
(!CKFEQ Result ANSWER (QUOTE FORM]
(QUOTE 343Q)
FORM)))
(PUTPROPS CKFUZZYEQ MACRO ((FORM ANSWER)
([LAMBDA (Password Result)
(DECLARE (LOCALVARS Password Result))
(OR (EQ Password (QUOTE 343Q))
(RAID (QUOTE WRONG#PUSHED)))
(!CKFUZZYEQ Result ANSWER (QUOTE FORM]
(QUOTE 343Q)
FORM)))
[PUTPROPS MTCHECK MACRO (Y (CONS (QUOTE MTCHECKSTK)
(MAPCAR Y (FUNCTION (LAMBDA (X)
(LIST (QUOTE MTCHECK1)
X]
[PUTPROPS MTCHECK1 MACRO ((X)
(OR X (MTHELP (QUOTE (Failed: X]
)
)
(DEFINEQ
(!DIAGNOSE
[LAMBDA NIL (* JonL " 7-Nov-84 19:20")
(!NUMBERTEST)
(!FNUMTEST)
(!MIXNUMTEST)
(!GCTEST)
(!CONSTEST)
(!FVARTEST)
(!INTERPTEST)
(CHECKCONSPAGES])
(!DIAGNOSELP
(LAMBDA NIL (* JonL " 7-Nov-84 18:42")
(PROG ((I 0))
LP (!DIAGNOSE)
(\STOPDISPLAY)
(\RELEASEWORKINGSET)
(\STARTDISPLAY)
(printout T "Pass " (add I 1)
" completed." T)
(GO LP))))
)
(* "Basic entries")
(RPAQ? ERRORMESSAGESTREAM T)
(RPAQ? !MTALLOWINEXACTFLG T)
(RPAQ? !MTUSERAIDFLG T)
(DEFINEQ
(!CKEQ
(LAMBDA (RESULT ANSWER FORM) (* JonL " 7-Nov-84 17:20")
(OR (EQ RESULT ANSWER)
(AND (EQ (NTYPX RESULT)
(NTYPX ANSWER))
(EQUAL RESULT ANSWER))
(!MRAID (LIST FORM (QUOTE =>)
RESULT
(QUOTE should-have-been)
ANSWER)))))
(!CKFEQ
(LAMBDA (RESULT ANSWER FORM) (* JonL " 7-Nov-84 17:20")
(OR (AND (FLOATP RESULT)
(FEQP RESULT ANSWER))
(!MRAID (LIST FORM (QUOTE =>)
RESULT
(QUOTE should-have-been)
ANSWER)))))
(!CKFUZZYEQ
(LAMBDA (X Y) (* JonL " 7-Nov-84 17:21")
(* Essentially FEQP except that the low-order bit is
ignored.)
(OR (AND (FLOATP X)
(FLOATP Y))
(!MRAID "An arg to CKFUZZYEQ is non-FLOATP"))
(AND (EQ (BITCLEAR (fetch (FLOATP LOWORD) of X)
1)
(BITCLEAR (fetch (FLOATP LOWORD) of Y)
1))
(OR (EQ (fetch (FLOATP HIWORD) of X)
(fetch (FLOATP HIWORD) of Y))
(AND (EQ 0 (fetch (FLOATP HIWORDNOSIGNBIT) of X))
(EQ 0 (fetch (FLOATP HIWORDNOSIGNBIT) of Y)))))))
(!MRAID
(LAMBDA (MESS1 MESS2 FLG) (* JonL " 7-Nov-84 17:28")
(if !MTUSERAIDFLG
then (RAID MESS1 MESS2 FLG)
else (printout ERRORMESSAGESTREAM "[RAID-level error] " MESS1 MESS2 T))))
)
(* "Utility fns")
(DEFINEQ
(!CONSTEST
(LAMBDA NIL (* JonL " 7-Nov-84 19:18")
(PROG (A B C D)
(MTCHECKSTK (PROG1 NIL (SETQ A (CONS (QUOTE A)
(QUOTE B)))
(MTCHECK (EQ (CAR A)
(QUOTE A))
(EQ (CDR A)
(QUOTE B)))
(SETQ A (CONS (QUOTE A)
(SETQ B (QUOTE (D E F)))))
(MTCHECK (EQ (CAR A)
(QUOTE A))
(EQ (CDR A)
B))
(SETQ A (DOCOLLECT (CONS 1)))
(MTCHECK (EQUAL (CAR A)
(QUOTE (1)))
(EQ (CDR A)
A)
(EQ (\REFCNT A)
1)
(EQ (\REFCNT (CAR A))
1))
(for X on (CDR (for I from 1 to 400Q collect (CONS I)))
do (MTCHECK (EQ (\REFCNT X)
1))
(EQ (\REFCNT (CAR X))
1))
(SETQ D (for I from 0 to 1000Q collect (LIST I)))
(for X on D do (PROG ((Y (CDR X))
(AX (CAR X))
(AY (CADR X))
(DY (CDDR X)))
(OR Y (RETURN))
(MTCHECK (PROGN (swap (CAR X)
(CAR Y))
(AND (EQ (CAR X)
AY)
(EQ (CAR Y)
AX))))
(MTCHECK (PROGN (swap (CDR Y)
(CDR X))
(AND (EQ (CDR X)
DY)
(EQ (CDR Y)
Y))))
(MTCHECK (PROGN
(* Now put them back)
(swap (CAR X)
(CAR Y))
(swap (CDR Y)
(CDR X))
(AND (EQ Y (CDR X))
(EQ (CAR X)
AX)
(EQ (CAR Y)
AY))))))
(for VAR in (LIST NIL D "A STRING")
do (for X on D do (MTCHECK (EQ (PROG1 (CDR X)
(swap (CDR X)
VAR)
(swap (CDR X)
VAR))
(CDR X)))))
(for X on (CDR D) do (MTCHECK (EQ (\REFCNT X)
1)
(EQ (\REFCNT (CAR X))
1)))
(for I from 0 to 1000Q do (MTCHECK (EQUAL (pop D)
(LIST I))))
(for X
in (QUOTE ((((A) . B))
(A B)
((A B . C))
((A B C D . E))
((A . B)
(C . D)
(E . F)
((((((((((((((G)))))))))))))))
(1 2 3 4 5 6 7 10Q 11Q 12Q 13Q 14Q 15Q 16Q 17Q 20Q 21Q 22Q
23Q 24Q)))
bind Y K Z
do (MTCHECK (EQUAL X (SETQ Y (!COPY X))))
(MTCHECK (EQUAL X (SETQ Z (COPY X))))
(MTCHECK (EQUAL X (SETQ Z (!SMASH Z))))
(MTCHECK (EQUAL X (SETQ K (MAPCAR X (FUNCTION (LAMBDA (YY)
YY))))))))))))
(!COPY
(LAMBDA (X) (* lmm "25-FEB-81 21:47")
(COND
((NLISTP X)
X)
(T (CONS (!COPY (CAR X))
(!COPY (CDR X)))))))
(!SMASH
(LAMBDA (X) (* bvm: "14-JAN-82 17:04")
(COND
((LISTP X)
(RPLACD (RPLACA X (!SMASH (CAR X)))
(!SMASH (CDR X))))
((NULL X)
(RPLACA (RPLACD X X)
X))
(T X))))
(!APPENDTEST
(LAMBDA NIL (* JonL "16-Dec-84 21:06")
(to 1750Q do (MTCHECK (EQUAL (QUOTE (A B C D))
(APPEND (QUOTE (A B))
(QUOTE (C D))))))
(to 1000Q do (MTCHECK (EQUAL (QUOTE (A B . C))
(APPEND (QUOTE (A B))
(QUOTE C)))))))
)
(DEFINEQ
(!INTERPTEST
(LAMBDA NIL (* lmm "30-MAY-83 19:40")
(PROG (INTERPDEF ANON)
(PUTD (QUOTE !INTERPTESTER)
(SETQ INTERPDEF (LIST (QUOTE LAMBDA)
NIL
(QUOTE (!CHECKARGS)))))
(for FORMAL in (QUOTE (NIL (A)
(A B)
(A B C)
(A B C D)
(A B C D E)
(A B C D E F)
N))
do (RPLACA (CDR INTERPDEF)
FORMAL)
(for ACTUAL in (QUOTE (NIL (1)
(1 2)
(1 2 3)
(1 2 3 4)
(1 2 3 4 5)
(1 2 3 4 5 6)))
do (SETQ ANON T)
(APPLY INTERPDEF ACTUAL)
(EVAL (CONS INTERPDEF ACTUAL))
(SETQ ANON)
(APPLY (QUOTE !INTERPTESTER)
ACTUAL)
(EVAL (CONS (QUOTE !INTERPTESTER)
ACTUAL))
(COND
((EQ FORMAL (QUOTE N))
(APPLY (QUOTE (LAMBDA N (PROG ((I 1))
LP (COND
((NOT (IGREATERP I N))
(!CHECKLSTARARG I (ARG N I))
(SETQ I (ADD1 I))
(GO LP)))
(SETQ I 1)
LP2 (COND
((NOT (IGREATERP I N))
(SETARG N I (IPLUS 310Q I))
(!CHECKLSTARSETARG I (ARG N I))
(SETQ I (ADD1 I))
(GO LP2))))))
ACTUAL)))))
(PROG (A B C D)
(for PAIR in (QUOTE ((3 3)
(T T)
(NIL NIL)
((SETQ FOOVAR 3)
3)
(A NIL)
(B NIL)
(C NIL)
(D NIL)
((SETTOPVAL (QUOTE FOOVAR)
45Q)
45Q)
(FOOVAR 45Q)
((SETQ A 47Q)
47Q)
((SETQ B 57Q)
57Q)
((SETQ C 102Q)
102Q)
(A 47Q)
(B 57Q)
(C 102Q)
((PROG NIL
(RETURN 14Q))
14Q)
((PROG NIL
(GO L1)
L1 (RETURN 145Q)
(RETURN 146Q)
(RETURN 147Q))
145Q)
((PROG ((A 504Q))
(RETURN A))
504Q)
((PROG ((A 1777Q)
(B 634Q))
(OR (AND (EQ A 1777Q)
(EQ B 634Q))
(MTHELP)))
NIL)))
do (OR (EQ (EVAL (CAR PAIR))
(CADR PAIR))
(MTHELP PAIR "TEST FAILED")))
(OR (AND (EQ A 47Q)
(EQ B 57Q)
(EQ C 102Q)
(EQ FOOVAR 45Q))
(MTHELP (QUOTE (COMPILEVAL))))))))
(!CHECKARGS
(LAMBDA NIL
(DECLARE (USEDFREE ACTUAL ANON FORMAL INTERPDEF A B C D E F N))
(* JonL " 7-Nov-84 17:15")
(COND
((LISTP FORMAL)
(for Y in FORMAL as (X ← ACTUAL) bind VAL by (CDR X)
do (COND
((OR (NEQ (SETQ VAL (SELECTQ Y
(A A)
(B B)
(C C)
(D D)
(E E)
(F F)
(SHOULDNT)))
(CAR X))
(NEQ (SETQ VAL (EVALV Y))
(CAR X)))
(MTHELP Y "Free Value wrong - was " VAL "should be" (CAR X))))))
(FORMAL (OR (AND (EQ (EVALV FORMAL)
(LENGTH ACTUAL))
(EQ N (EVALV FORMAL)))
(MTHELP (QUOTE ARGCOUNT)))
(for I from 1 to N as X in ACTUAL do (OR (EQ (ARG N I)
X)
(MTHELP (QUOTE ARG)
I)))))
(PROG ((FRAME (REALSTKNTH -1 (QUOTE !CHECKARGS)))
SCANFRAME NARGS NAME)
(OR FRAME (MTHELP "Interpreter frame not found"))
(OR (EQ (COND
(ANON INTERPDEF)
(T (QUOTE !INTERPTESTER)))
(SETQ NAME (STKNAME FRAME)))
(MTHELP "Interpreter frame name wrong:" NAME))
(for X in FORMAL
do (OR (EQP FRAME (SETQ SCANFRAME (STKSCAN X)))
(MTHELP "STKSCAN failed for var" X))
(RELSTK SCANFRAME))
(OR (IGEQ (SETQ NARGS (STKNARGS FRAME))
(LENGTH FORMAL))
(MTHELP "STKNARGS WRONG" NARGS))
(RELSTK FRAME))))
(!CHECKLSTARARG
(LAMBDA (I VAL) (* bvm: "26-SEP-81 21:19")
(OR (EQ VAL (CAR (NTH ACTUAL I)))
(MTHELP "INTERPRETED ARG" I))))
(!CHECKLSTARSETARG
(LAMBDA (I VAL) (* bvm: "26-SEP-81 21:20")
(OR (EQ VAL (IPLUS I 310Q))
(MTHELP "INTERPRETED SETARG" I))))
)
(* "CONS and RPLAC tests")
(DEFINEQ
(!GCTEST
[LAMBDA NIL (* bvm: "30-NOV-81 17:23")
(!GCTEST1)
(!GCTEST2])
(!GCTEST1
[LAMBDA NIL
(DECLARE (GLOBALVARS !GV1 !GV2 !GV3)) (* JonL "16-Mar-84 12:10")
(PROG (A B C D E)
(MTCHECK (PROGN (SETQ A (CONS 1 2))
(EQ (\REFCNT A)
0))
(PROGN (SETQ B (CONS A))
(AND (EQ (\REFCNT A)
1)
(EQ (\REFCNT B)
0)))
(PROGN (SETQ C (CONS A))
(AND (EQ (\REFCNT A)
2)
(EQ (\REFCNT C)
0)))
(PROGN (RPLACA B (QUOTE FOO))
(AND (EQ (\REFCNT A)
1)
(EQ (\REFCNT B)
0)))
(PROGN (RPLACA C (QUOTE FUM))
(AND (EQ (\REFCNT A)
0)
(EQ (\REFCNT C)
0)))
(PROGN (RPLACD C (SETQ D (CONS)))
(EQ (\REFCNT D)
1))
(PROGN (RPLACD C (SETQ E (CONS)))
(AND (EQ (\REFCNT D)
0)
(EQ (\REFCNT E)
1)))
(PROGN (SETQ !GV1 NIL)
(EQ (\REFCNT !GV1)
1))
(PROGN (SETQ !GV1 E)
(EQ (\REFCNT E)
2))
(PROGN (SETQ !GV1 A)
(AND (EQ (\REFCNT E)
1)
(EQ (\REFCNT A)
1)))
(PROGN (SETQ !GV3 A)
(EQ (\REFCNT A)
2))
(PROGN (SETQ !GV2 C)
(EQ (\REFCNT C)
1])
(!GCTEST2
[LAMBDA NIL (* JonL "16-Mar-84 14:03")
(PROG ((A (CONS (QUOTE FOO)))
(I 0)
(REFARRAY (ARRAY 200Q (QUOTE POINTER)
NIL 0)))
[RPTQ 106Q (MTCHECK (PROGN (SETA REFARRAY (add I 1)
A)
(EQ (\REFCNT A)
I]
(RPTQ 106Q (MTCHECK (PROGN (SETA REFARRAY (PROG1 I (add I -1))
NIL)
(EQ (\REFCNT A)
I])
(!GCTESTSETF
(LAMBDA NIL (* JonL "16-Mar-84 12:17")
(PROG ((A1 (VAG2 71Q 442Q))
(A2 (VAG2 72Q 442Q))
(A3 (VAG2 70Q 442Q))
(A4 (VAG2 67Q 442Q))
(A5 (VAG2 66Q 442Q))) (* 5 array pointers that will hash to same place)
(* (PROG ((STATE (for X in (QUOTE (A1 A2 A3 A4 A5)) collect (LIST X 1))) FORMS FORM BOX1STATE BOX2STATE)
(FRPTQ 12Q (FRPTQ 12Q (SETQ VAR (CAR (NTH STATE (RAND 1 5)))) (PROG NIL RETRY (SELECTQ (RAND 1 4)
(1 (COND (BOX1STATE (COND ((ZEROP (CADR BOX1STATE)) (GO RETRY))) (add (CADR BOX1STATE) -1)))
(add (CADR VAR) 1) (SETQ BOX1STATE VAR) (push FORMS (LIST (QUOTE SETQ) (QUOTE !FVAR1) (CAR VAR))))
(2 (COND (BOX2STATE (COND ((ZEROP (CADR BOX2STATE)) (GO RETRY))) (add (CADR BOX2STATE) -1)))
(add (CADR VAR) 1) (SETQ BOX2STATE VAR) (push FORMS (LIST (QUOTE SETQ) (QUOTE !FVAR2) (CAR VAR))))
(3 (add (CADR VAR) 1) (push FORMS (LIST (QUOTE \ADDREF) (CAR VAR)))) (PROGN (COND ((ZEROP (CADR VAR))
(GO RETRY))) (add (CADR VAR) -1) (push FORMS (LIST (QUOTE \DELREF) (CAR VAR))))))) (push FORMS
(CONS (QUOTE MTCHECK) (for X in STATE collect (LIST (QUOTE EQ) (LIST (QUOTE \REFCNT) (CAR X))
(CADR X)))))) (for X in STATE do (COND ((ZEROP (CADR X)) (push FORMS (LIST (QUOTE \ADDREF) (CAR X))))
(T (FRPTQ (SUB1 (CADR X)) (push FORMS (LIST (QUOTE \DELREF) (CAR X))))))) (RETURN (CONS (QUOTE PROGN)
(REVERSE FORMS)))))
(MTCHECKSTK (\DELREF A3)
(SETQ !FVAR2 A1)
(SETQ !FVAR1 A3)
(SETQ !FVAR2 A1)
(SETQ !FVAR1 A1)
(SETQ !FVAR2 A5)
(\ADDREF A1)
(SETQ !FVAR1 A2)
(\DELREF A1)
(\ADDREF A5)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
0)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
3))
(SETQ !FVAR1 A5)
(\ADDREF A4)
(\ADDREF A2)
(\ADDREF A5)
(SETQ !FVAR2 A5)
(SETQ !FVAR1 A4)
(\ADDREF A3)
(SETQ !FVAR1 A3)
(SETQ !FVAR2 A2)
(SETQ !FVAR2 A4)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
3)
(EQ (\REFCNT A5)
3))
(\ADDREF A5)
(SETQ !FVAR1 A2)
(SETQ !FVAR2 A4)
(SETQ !FVAR1 A5)
(SETQ !FVAR2 A5)
(\DELREF A1)
(SETQ !FVAR1 A1)
(\DELREF A1)
(\ADDREF A4)
(\DELREF A4)
(MTCHECK (EQ (\REFCNT A1)
0)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
2)
(EQ (\REFCNT A5)
5))
(SETQ !FVAR2 A5)
(\DELREF A4)
(SETQ !FVAR2 A5)
(\DELREF A3)
(\ADDREF A1)
(SETQ !FVAR1 A1)
(SETQ !FVAR2 A5)
(SETQ !FVAR2 A3)
(\DELREF A1)
(\DELREF A2)
(MTCHECK (EQ (\REFCNT A1)
0)
(EQ (\REFCNT A2)
1)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
4))
(SETQ !FVAR2 A1)
(SETQ !FVAR2 A4)
(\DELREF A4)
(\ADDREF A1)
(SETQ !FVAR1 A3)
(SETQ !FVAR1 A5)
(\ADDREF A3)
(\ADDREF A1)
(\ADDREF A4)
(SETQ !FVAR2 A3)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
1)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
5))
(SETQ !FVAR2 A2)
(SETQ !FVAR1 A3)
(\ADDREF A5)
(SETQ !FVAR2 A1)
(SETQ !FVAR2 A5)
(\DELREF A2)
(SETQ !FVAR2 A2)
(\DELREF A2)
(SETQ !FVAR1 A5)
(SETQ !FVAR1 A3)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
5))
(\ADDREF A1)
(\DELREF A1)
(\ADDREF A5)
(\ADDREF A5)
(SETQ !FVAR1 A5)
(SETQ !FVAR1 A4)
(SETQ !FVAR1 A4)
(SETQ !FVAR1 A2)
(SETQ !FVAR2 A2)
(\ADDREF A2)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
7))
(\DELREF A5)
(SETQ !FVAR2 A5)
(\ADDREF A2)
(\ADDREF A1)
(\DELREF A1)
(\ADDREF A5)
(SETQ !FVAR1 A3)
(\ADDREF A2)
(SETQ !FVAR1 A3)
(\ADDREF A4)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
2)
(EQ (\REFCNT A5)
10Q))
(\ADDREF A2)
(\DELREF A5)
(\DELREF A3)
(SETQ !FVAR2 A5)
(SETQ !FVAR1 A4)
(SETQ !FVAR1 A2)
(SETQ !FVAR1 A5)
(\DELREF A5)
(SETQ !FVAR2 A5)
(SETQ !FVAR1 A2)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
4)
(EQ (\REFCNT A3)
0)
(EQ (\REFCNT A4)
2)
(EQ (\REFCNT A5)
6))
(SETQ !FVAR1 A5)
(SETQ !FVAR2 A5)
(\DELREF A2)
(SETQ !FVAR1 A1)
(SETQ !FVAR2 A2)
(SETQ !FVAR2 A1)
(\ADDREF A5)
(SETQ !FVAR2 A4)
(SETQ !FVAR1 A5)
(SETQ !FVAR2 A2)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
3)
(EQ (\REFCNT A3)
0)
(EQ (\REFCNT A4)
2)
(EQ (\REFCNT A5)
7))
(\DELREF A2)
(\DELREF A2)
(\ADDREF A3)
(\DELREF A4)
(\DELREF A5)
(\DELREF A5)
(\DELREF A5)
(\DELREF A5)
(\DELREF A5)
(\DELREF A5)
(SETQ.NOREF !FVAR1 NIL)
(SETQ.NOREF !FVAR2 NIL))
(MTCHECKSTK (\DELREF A5)
(SETQ !FVAR1 A5)
(SETQ !FVAR2 A2)
(\ADDREF A1)
(SETQ !FVAR1 A2)
(\ADDREF A4)
(SETQ !FVAR1 A1)
(\DELREF A2)
(SETQ !FVAR2 A5)
(SETQ !FVAR1 A5)
(MTCHECK (EQ (\REFCNT A1)
2)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
2)
(EQ (\REFCNT A5)
2))
(\ADDREF A4)
(\DELREF A3)
(\ADDREF A3)
(\ADDREF A2)
(SETQ !FVAR1 A4)
(\ADDREF A4)
(\DELREF A2)
(\ADDREF A3)
(SETQ !FVAR1 A2)
(\ADDREF A2)
(MTCHECK (EQ (\REFCNT A1)
2)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
4)
(EQ (\REFCNT A5)
1))
(SETQ !FVAR2 A1)
(SETQ !FVAR1 A3)
(SETQ !FVAR2 A1)
(SETQ !FVAR2 A3)
(SETQ !FVAR1 A2)
(SETQ !FVAR2 A4)
(\DELREF A2)
(SETQ !FVAR2 A2)
(SETQ !FVAR2 A5)
(SETQ !FVAR2 A4)
(MTCHECK (EQ (\REFCNT A1)
2)
(EQ (\REFCNT A2)
1)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
5)
(EQ (\REFCNT A5)
0))
(\ADDREF A3)
(SETQ !FVAR2 A1)
(\DELREF A1)
(\ADDREF A5)
(\ADDREF A5)
(\ADDREF A4)
(SETQ !FVAR2 A4)
(SETQ !FVAR1 A5)
(\ADDREF A4)
(SETQ !FVAR2 A2)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
1)
(EQ (\REFCNT A3)
3)
(EQ (\REFCNT A4)
6)
(EQ (\REFCNT A5)
3))
(SETQ !FVAR2 A2)
(\ADDREF A1)
(SETQ !FVAR1 A5)
(SETQ !FVAR1 A4)
(SETQ !FVAR2 A5)
(\DELREF A3)
(\ADDREF A3)
(SETQ !FVAR2 A5)
(SETQ !FVAR2 A4)
(\ADDREF A3)
(MTCHECK (EQ (\REFCNT A1)
2)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
4)
(EQ (\REFCNT A4)
10Q)
(EQ (\REFCNT A5)
2))
(\DELREF A3)
(\ADDREF A4)
(\ADDREF A5)
(SETQ !FVAR2 A1)
(\ADDREF A1)
(\ADDREF A4)
(\ADDREF A2)
(\DELREF A4)
(SETQ !FVAR2 A2)
(\DELREF A2)
(MTCHECK (EQ (\REFCNT A1)
3)
(EQ (\REFCNT A2)
1)
(EQ (\REFCNT A3)
3)
(EQ (\REFCNT A4)
10Q)
(EQ (\REFCNT A5)
3))
(SETQ !FVAR1 A2)
(SETQ !FVAR2 A1)
(SETQ !FVAR1 A5)
(SETQ !FVAR1 A3)
(\DELREF A3)
(SETQ !FVAR1 A1)
(\ADDREF A4)
(\ADDREF A4)
(\DELREF A3)
(SETQ !FVAR1 A1)
(MTCHECK (EQ (\REFCNT A1)
5)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
11Q)
(EQ (\REFCNT A5)
3))
(SETQ !FVAR2 A1)
(\ADDREF A4)
(SETQ !FVAR1 A3)
(SETQ !FVAR2 A3)
(SETQ !FVAR1 A2)
(SETQ !FVAR1 A1)
(SETQ !FVAR2 A2)
(SETQ !FVAR1 A5)
(SETQ !FVAR1 A5)
(SETQ !FVAR2 A5)
(MTCHECK (EQ (\REFCNT A1)
3)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
12Q)
(EQ (\REFCNT A5)
5))
(SETQ !FVAR1 A3)
(SETQ !FVAR2 A3)
(\ADDREF A2)
(SETQ !FVAR2 A5)
(\ADDREF A4)
(\DELREF A1)
(SETQ !FVAR1 A4)
(\DELREF A1)
(\DELREF A2)
(\ADDREF A5)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
14Q)
(EQ (\REFCNT A5)
5))
(\ADDREF A1)
(SETQ !FVAR2 A3)
(SETQ !FVAR1 A4)
(SETQ !FVAR1 A3)
(SETQ !FVAR2 A1)
(SETQ !FVAR1 A2)
(\ADDREF A4)
(\ADDREF A4)
(\ADDREF A4)
(\ADDREF A1)
(MTCHECK (EQ (\REFCNT A1)
4)
(EQ (\REFCNT A2)
1)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
16Q)
(EQ (\REFCNT A5)
4))
(\DELREF A1)
(\DELREF A1)
(\DELREF A1)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A4)
(\DELREF A5)
(\DELREF A5)
(\DELREF A5)
(SETQ.NOREF !FVAR1 NIL)
(SETQ.NOREF !FVAR2 NIL)))))
(!GCTESTSETG
(LAMBDA NIL (* JonL "16-Mar-84 12:17")
(DECLARE (GLOBALVARS !GVAR1 !GVAR2))
(PROG ((A1 (VAG2 71Q 442Q))
(A2 (VAG2 72Q 442Q))
(A3 (VAG2 70Q 442Q))
(A4 (VAG2 67Q 442Q))
(A5 (VAG2 66Q 442Q))) (* 5 array pointers that will hash to same place)
(* (PROG ((STATE (for X in (QUOTE (A1 A2 A3 A4 A5)) collect (LIST X 1))) FORMS FORM BOX1STATE BOX2STATE)
(FRPTQ 12Q (FRPTQ 12Q (SETQ VAR (CAR (NTH STATE (RAND 1 5)))) (PROG NIL RETRY (SELECTQ (RAND 1 4)
(1 (COND (BOX1STATE (COND ((ZEROP (CADR BOX1STATE)) (GO RETRY))) (add (CADR BOX1STATE) -1)))
(add (CADR VAR) 1) (SETQ BOX1STATE VAR) (push FORMS (LIST (QUOTE SETQ) (QUOTE !GVAR1) (CAR VAR))))
(2 (COND (BOX2STATE (COND ((ZEROP (CADR BOX2STATE)) (GO RETRY))) (add (CADR BOX2STATE) -1)))
(add (CADR VAR) 1) (SETQ BOX2STATE VAR) (push FORMS (LIST (QUOTE SETQ) (QUOTE !GVAR2) (CAR VAR))))
(3 (add (CADR VAR) 1) (push FORMS (LIST (QUOTE \ADDREF) (CAR VAR)))) (PROGN (COND ((ZEROP (CADR VAR))
(GO RETRY))) (add (CADR VAR) -1) (push FORMS (LIST (QUOTE \DELREF) (CAR VAR))))))) (push FORMS
(CONS (QUOTE MTCHECK) (for X in STATE collect (LIST (QUOTE EQ) (LIST (QUOTE \REFCNT) (CAR X))
(CADR X)))))) (for X in STATE do (COND ((ZEROP (CADR X)) (push FORMS (LIST (QUOTE \ADDREF) (CAR X))))
(T (FRPTQ (SUB1 (CADR X)) (push FORMS (LIST (QUOTE \DELREF) (CAR X))))))) (RETURN (CONS (QUOTE PROGN)
(REVERSE FORMS)))))
(MTCHECKSTK (SETQ !GVAR1 A4)
(\DELREF A2)
(SETQ !GVAR1 A4)
(\ADDREF A3)
(SETQ !GVAR1 A4)
(SETQ !GVAR2 A4)
(SETQ !GVAR2 A5)
(SETQ !GVAR1 A2)
(\DELREF A2)
(\DELREF A3)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
2))
(\DELREF A3)
(SETQ !GVAR2 A1)
(\ADDREF A4)
(SETQ !GVAR2 A5)
(SETQ !GVAR2 A2)
(\ADDREF A3)
(SETQ !GVAR1 A2)
(\DELREF A4)
(\DELREF A1)
(\DELREF A4)
(MTCHECK (EQ (\REFCNT A1)
0)
(EQ (\REFCNT A2)
1)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
1))
(\DELREF A2)
(\ADDREF A2)
(\DELREF A3)
(\ADDREF A1)
(SETQ !GVAR2 A1)
(\ADDREF A5)
(SETQ !GVAR2 A4)
(\ADDREF A5)
(\ADDREF A5)
(\ADDREF A1)
(MTCHECK (EQ (\REFCNT A1)
2)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
0)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
4))
(SETQ !GVAR2 A4)
(\ADDREF A5)
(SETQ !GVAR2 A5)
(\ADDREF A1)
(SETQ !GVAR2 A5)
(SETQ !GVAR2 A2)
(SETQ !GVAR1 A4)
(SETQ !GVAR1 A4)
(\DELREF A4)
(\ADDREF A4)
(MTCHECK (EQ (\REFCNT A1)
3)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
0)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
5))
(\DELREF A5)
(SETQ !GVAR1 A5)
(\ADDREF A4)
(\ADDREF A1)
(SETQ !GVAR1 A1)
(\DELREF A4)
(SETQ !GVAR1 A5)
(SETQ !GVAR1 A2)
(\ADDREF A3)
(SETQ !GVAR1 A1)
(MTCHECK (EQ (\REFCNT A1)
5)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
4))
(\ADDREF A2)
(\DELREF A3)
(SETQ !GVAR2 A4)
(SETQ !GVAR2 A4)
(SETQ !GVAR2 A3)
(SETQ !GVAR2 A2)
(\ADDREF A2)
(SETQ !GVAR2 A5)
(\ADDREF A4)
(\DELREF A2)
(MTCHECK (EQ (\REFCNT A1)
5)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
0)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
5))
(SETQ !GVAR1 A2)
(SETQ !GVAR1 A4)
(\ADDREF A3)
(\DELREF A4)
(SETQ !GVAR1 A2)
(SETQ !GVAR2 A4)
(\DELREF A1)
(SETQ !GVAR1 A3)
(SETQ !GVAR2 A1)
(SETQ !GVAR2 A5)
(MTCHECK (EQ (\REFCNT A1)
3)
(EQ (\REFCNT A2)
0)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
5))
(SETQ !GVAR2 A3)
(SETQ !GVAR1 A2)
(\ADDREF A1)
(\ADDREF A5)
(\ADDREF A2)
(\DELREF A5)
(\DELREF A2)
(\DELREF A1)
(\ADDREF A2)
(SETQ !GVAR2 A4)
(MTCHECK (EQ (\REFCNT A1)
3)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
4))
(\DELREF A1)
(\ADDREF A5)
(\DELREF A1)
(\DELREF A5)
(\DELREF A3)
(\ADDREF A3)
(SETQ !GVAR1 A1)
(SETQ !GVAR2 A2)
(\ADDREF A2)
(SETQ !GVAR2 A2)
(MTCHECK (EQ (\REFCNT A1)
2)
(EQ (\REFCNT A2)
3)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
4))
(\ADDREF A3)
(\ADDREF A1)
(SETQ !GVAR2 A5)
(SETQ !GVAR1 A3)
(SETQ !GVAR2 A2)
(SETQ !GVAR1 A2)
(SETQ !GVAR2 A4)
(\DELREF A3)
(SETQ !GVAR2 A4)
(\DELREF A1)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
3)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
4))
(\DELREF A2)
(\DELREF A2)
(\DELREF A5)
(\DELREF A5)
(\DELREF A5)
(SETQ.NOREF !GVAR1 NIL)
(SETQ.NOREF !GVAR2 NIL))
(MTCHECKSTK (\ADDREF A3)
(\DELREF A1)
(SETQ !GVAR2 A1)
(SETQ !GVAR1 A2)
(SETQ !GVAR2 A2)
(\ADDREF A3)
(SETQ !GVAR2 A3)
(\DELREF A5)
(SETQ !GVAR2 A4)
(\ADDREF A2)
(MTCHECK (EQ (\REFCNT A1)
0)
(EQ (\REFCNT A2)
3)
(EQ (\REFCNT A3)
3)
(EQ (\REFCNT A4)
2)
(EQ (\REFCNT A5)
0))
(SETQ !GVAR1 A5)
(SETQ !GVAR2 A3)
(SETQ !GVAR1 A5)
(SETQ !GVAR1 A1)
(\DELREF A1)
(SETQ !GVAR2 A5)
(\ADDREF A1)
(SETQ !GVAR1 A1)
(\DELREF A4)
(SETQ !GVAR1 A4)
(MTCHECK (EQ (\REFCNT A1)
0)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
3)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
1))
(SETQ !GVAR2 A5)
(SETQ !GVAR1 A1)
(\ADDREF A5)
(\ADDREF A4)
(\DELREF A2)
(SETQ !GVAR2 A5)
(\DELREF A4)
(SETQ !GVAR1 A5)
(\ADDREF A2)
(SETQ !GVAR1 A4)
(MTCHECK (EQ (\REFCNT A1)
0)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
3)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
2))
(\DELREF A2)
(\DELREF A4)
(\DELREF A2)
(\ADDREF A2)
(SETQ !GVAR2 A2)
(\ADDREF A5)
(\ADDREF A2)
(\ADDREF A1)
(SETQ !GVAR2 A3)
(\ADDREF A5)
(MTCHECK (EQ (\REFCNT A1)
1)
(EQ (\REFCNT A2)
2)
(EQ (\REFCNT A3)
4)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
3))
(\ADDREF A2)
(\DELREF A5)
(\ADDREF A1)
(SETQ !GVAR2 A4)
(SETQ !GVAR2 A2)
(SETQ !GVAR2 A5)
(\DELREF A3)
(\ADDREF A2)
(SETQ !GVAR2 A1)
(\DELREF A5)
(MTCHECK (EQ (\REFCNT A1)
3)
(EQ (\REFCNT A2)
4)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
1))
(\DELREF A2)
(SETQ !GVAR2 A2)
(SETQ !GVAR2 A5)
(\ADDREF A1)
(SETQ !GVAR2 A2)
(\DELREF A3)
(\ADDREF A5)
(SETQ !GVAR2 A5)
(SETQ !GVAR2 A1)
(SETQ !GVAR2 A1)
(MTCHECK (EQ (\REFCNT A1)
4)
(EQ (\REFCNT A2)
3)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
2))
(\ADDREF A5)
(SETQ !GVAR2 A4)
(\DELREF A1)
(\ADDREF A3)
(\DELREF A3)
(SETQ !GVAR2 A2)
(SETQ !GVAR2 A2)
(\DELREF A2)
(\DELREF A5)
(\ADDREF A2)
(MTCHECK (EQ (\REFCNT A1)
2)
(EQ (\REFCNT A2)
4)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
2))
(SETQ !GVAR2 A1)
(\DELREF A1)
(\DELREF A5)
(SETQ !GVAR2 A1)
(SETQ !GVAR2 A2)
(\ADDREF A2)
(\ADDREF A4)
(SETQ !GVAR1 A4)
(SETQ !GVAR1 A5)
(\ADDREF A1)
(MTCHECK (EQ (\REFCNT A1)
2)
(EQ (\REFCNT A2)
5)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
2))
(SETQ !GVAR1 A4)
(SETQ !GVAR1 A4)
(\DELREF A5)
(\ADDREF A5)
(SETQ !GVAR2 A1)
(SETQ !GVAR2 A2)
(\DELREF A5)
(SETQ !GVAR1 A1)
(SETQ !GVAR2 A4)
(SETQ !GVAR2 A1)
(MTCHECK (EQ (\REFCNT A1)
4)
(EQ (\REFCNT A2)
4)
(EQ (\REFCNT A3)
1)
(EQ (\REFCNT A4)
0)
(EQ (\REFCNT A5)
0))
(SETQ !GVAR2 A4)
(\ADDREF A4)
(SETQ !GVAR2 A4)
(SETQ !GVAR1 A4)
(SETQ !GVAR2 A5)
(\ADDREF A3)
(SETQ !GVAR1 A4)
(\DELREF A4)
(\ADDREF A1)
(\ADDREF A5)
(MTCHECK (EQ (\REFCNT A1)
3)
(EQ (\REFCNT A2)
4)
(EQ (\REFCNT A3)
2)
(EQ (\REFCNT A4)
1)
(EQ (\REFCNT A5)
2))
(\DELREF A1)
(\DELREF A1)
(\DELREF A2)
(\DELREF A2)
(\DELREF A2)
(\DELREF A3)
(\DELREF A5)
(SETQ.NOREF !GVAR1 NIL)
(SETQ.NOREF !GVAR2 NIL)))))
)
(* "Test of garbage collector")
(DEFINEQ
(MINILOGOUT
(LAMBDA NIL (* bvm: "10-OCT-81 17:22")
(* * This one works for hacking in the init.sysout)
(\STOPDISPLAY)
(LOGOUT0)
(\STARTDISPLAY)
(\DEVICEEVENT (QUOTE AFTERLOGOUT))))
)
(* "File MACROTESTAUX contains freevar and numeric tests")
(DECLARE: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY
(FILESLOAD MACROTESTAUX)
)
(PUTPROPS MACROTEST COPYRIGHT ("Xerox Corporation" 3675Q 3676Q 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4763Q 6157Q (!DIAGNOSE 4775Q . 5421Q) (!DIAGNOSELP 5423Q . 6155Q)) (6355Q 11606Q (!CKEQ
6367Q . 7124Q) (!CKFEQ 7126Q . 7575Q) (!CKFUZZYEQ 7577Q . 11204Q) (!MRAID 11206Q . 11604Q)) (11641Q
21556Q (!CONSTEST 11653Q . 17770Q) (!COPY 17772Q . 20327Q) (!SMASH 20331Q . 20774Q) (!APPENDTEST
20776Q . 21554Q)) (21557Q 33054Q (!INTERPTEST 21571Q . 27012Q) (!CHECKARGS 27014Q . 32236Q) (
!CHECKLSTARARG 32240Q . 32546Q) (!CHECKLSTARSETARG 32550Q . 33052Q)) (33120Q 115472Q (!GCTEST 33132Q
. 33351Q) (!GCTEST1 33353Q . 36275Q) (!GCTEST2 36277Q . 37272Q) (!GCTESTSETF 37274Q . 66716Q) (
!GCTESTSETG 66720Q . 115470Q)) (115543Q 116215Q (MINILOGOUT 115555Q . 116213Q)))))
STOP