(FILECREATED "30-Jun-86 11:12:59" {ERIS}<TAMARIN>TUT>TUT1.;33 38432
changes to: (VARS TUT1COMS doTypeTest1 doTypeTest1A TypeTest2.3ptr DiffTest1A TypeTest2.2
TypeTest2 TypeTest2.1 TypeTest2.3type GreaterPTest1 GreaterPTest1A TypeTest1
DiffTest1 TypeTest1.1)
(FNS DoTypeTest2 DoTypeTest1 LoadTypeTest1)
previous date: "24-Jun-86 12:00:07" {ERIS}<TAMARIN>TUT>TUT1.;19)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TUT1COMS)
(RPAQQ TUT1COMS ((* * misc tests)
(VARS CopySwapPopTest CopySwapPopTest1)
(* * * * * REAL UFN-EDGE TESTS * * * * *)
(* * ARITH OPCODES -- status: -- ARITHUFNTEST1 PLUS DIFFERENCE NEG GREATERP ok --
IPLUS IDIFFERENCE IGREATERP supposed to share PLUS DIFFERENCE GREATERP ucode,
untested)
(VARS PlusTest1 DiffTest1 GreaterPTest1 NegTest1)
(* (StdUfn (QUOTE PLUS)
2)
(StdUfn (QUOTE DIFFERENCE)
2)
(StdUfn (QUOTE GREATERP)
2)
(StdUfn (QUOTE NEG)
1))
(VARS ArithUfnTest1)
(* (PROGN (StdUfn (QUOTE TIMES)
2)
(StdUfn (QUOTE QUOTIENT)
2)
(StdUfn (QUOTE ITIMES)
2)
(StdUfn (QUOTE IQUOTIENT)
2)
(StdUfn (QUOTE IREMAINDER)
2)))
(* * LOG OPCODES -- status: -- LOGAND LOGOR LOGXOR ok)
(VARS LogAndTest1 LogOrTest1 LogXorTest1)
(* (StdUfn (QUOTE LOGAND)
2)
(StdUfn (QUOTE LOGOR)
2)
(StdUfn (QUOTE LOGXOR)
2))
(* * SHIFT OPCODES -- ASH LLSH.N LRSH.N OK)
(VARS LlshNTest1 LrshNTest1 AshTest1)
(* (StdUfn (QUOTE LLSH.N)
2)
(StdUfn (QUOTE LRSH.N)
2)
(StdUfn (QUOTE ASH)
2))
(* * TYPE, CONSTANT, AND EQUALITY OPCODES)
(COMS (* * status of TypeTest1 -- either make GETPTRBITS work on non-PointerPs or
change the GETPTRBITS in TypeTest1.1 to something like <if pointerp then
getptrbits else settype.n←integerp)
(* * PUTxx, GETxx and the constant opcodes ICONST `0 `1 SICX SICXXX PCONST
ACONST 'T 'NIL 'UNBOUND FCONST XCONST)
(FNS DoTypeTest1)
(VARS doTypeTest1 doTypeTest1A)
(VARS TypeTest1 TypeTest1.1))
(COMS (* * status of TypeTest2 -- still trying to get the code of TypeTest2.3ptr
right -- may have GETPTRBITS problems like TypeTest1, too)
(* * test everything else -- except EQUAL CEQUAL which supposedly share
ucode with EQP)
(FNS DoTypeTest2)
(VARS TypeTest2 TypeTest2.1 TypeTest2.2 TypeTest2.3type TypeTest2.3ptr))))
(* * misc tests)
(RPAQQ CopySwapPopTest ((LAMBDA: CopySwapPopTest NIL)
CODE:
(StackCheck (SIC 0)
(SIC 7)
(FN2 CopySwapPopTest1)
(SIC 106)
(EQ)
(ElseStop))
('T)
(RETURN)))
(RPAQQ CopySwapPopTest1 ((LAMBDA: CopySwapPopTest1 (N CTR))
(VARS: N CTR)
CODE:
(V++ N)
(COPY)
(V++ N)
(SWAP)
(* -- 1 2 1, uses 2 more)
(V++ N)
(COPY)
(V++ N)
(SWAP)
(* -- 1 2 1, uses 2 more)
(V++' N)
(COPY)
(V++' N)
(SWAP)
(* -- 1 2 1, uses 2 more)
(V++' N)
(COPY)
(V++' N)
(SWAP)
(* -- 1 2 1, uses 2 more)
(V++ N)
(COPY)
(V++ N)
(SWAP)
(* -- 1 2 1, uses 2 more)
(V++ N)
(COPY)
(V++ N)
(SWAP)
(* -- 1 2 1, uses 2 more)
(V++' N)
(COPY)
(V++' N)
(SWAP)
(* 21 occupied, 23 used)
(V++ N)
(* 22 occupied, 24 used)
(VAR CTR)
('1)
(DIFFERENCE)
(VAR← CTR)
(* dec ctr, 23/24)
('0)
(EQ)
(TJUMP XX)
(* 22/24)
(VAR N)
(VAR CTR)
(FN2 CopySwapPopTest1)
(RETURN)
(* deeper 22/23)
XX
(* 22/24)
(VAR N)
('1)
(PLUS)
(VAR N)
(SWAP)
(RETURN)
(* unwind, 23/23)))
(* * * * * REAL UFN-EDGE TESTS * * * * *)
(* * ARITH OPCODES -- status: -- ARITHUFNTEST1 PLUS DIFFERENCE NEG GREATERP ok -- IPLUS
IDIFFERENCE IGREATERP supposed to share PLUS DIFFERENCE GREATERP ucode, untested)
(RPAQQ PlusTest1 ((LAMBDA: PlusTest1 NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE PLUS))
(equivFn (QUOTE PLUS)))
(* * make some non-integerPs)
(QUOTE (('0)
(SETTYPE.N 0)
(VAR←↑ aPtrP)
('0)
(SETTYPE.N 128)
(VAR←↑ aFloatP)
('0)
(SETTYPE.N 192)
(VAR←↑ anXP)))
(* * one arg 0 -- should work unless other arg is bad)
(ShouldWork (0 0)
(0 23)
(32 0)
(0 -25)
(-52 0)
(T.MaxInt 0)
(0 T.MaxInt)
(T.MinInt 0)
(0 T.MinInt))
[ShouldUFN ((QUOTE ((VAR aPtrP)))
0)
[0 (QUOTE ((VAR aPtrP]
((QUOTE ((VAR aFloatP)))
0)
[0 (QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
0)
(0 (QUOTE ((VAR anXP]
(* * two bad args)
[ShouldUFN [(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aFloatP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR anXP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aFloatP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR anXP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
(QUOTE ((VAR anXP]
(* * regular stuff)
(ShouldWork (12 23)
(34 -21)
(45 -45)
(56 -67))
(ShouldWork (-12 23)
(-34 34)
(-45 43)
(-45 -67))
(* * overflow edge testing)
[ShouldWork (T.MaxInt -1)
((SUB1 T.MaxInt)
1)
((DIFFERENCE T.MaxInt 321)
320)
((DIFFERENCE T.MaxInt 123)
123)
((LSH T.MaxInt -1)
(ADD1 (LSH T.MaxInt -1]
(ShouldUFN (T.MaxInt 1)
((SUB1 T.MaxInt)
2)
((DIFFERENCE T.MaxInt 123)
124)
((DIFFERENCE T.MaxInt 321)
736)
((ADD1 (LSH T.MaxInt -1))
(ADD1 (LSH T.MaxInt -1)))
(T.MaxInt T.MaxInt))
(ShouldWork (T.MinInt 1)
((ADD1 T.MinInt)
-1)
((PLUS T.MinInt 769)
-768)
((PLUS T.MinInt 123)
-123)
((LSH T.MinInt -1)
(LSH T.MinInt -1)))
(ShouldUFN (T.MinInt -1)
((ADD1 T.MinInt)
-2)
((PLUS T.MinInt 123)
-124)
((PLUS T.MinInt 769)
-1125)
((LRSH T.MinInt 1)
(SUB1 (LRSH T.MinInt 1)))
(T.MinInt T.MinInt)))
('T)
(RETURN)))
(RPAQQ DiffTest1 ((LAMBDA: DiffTest1 NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE DIFFERENCE))
(equivFn (QUOTE DIFFERENCE)))
(* * make some non-integerPs)
(QUOTE (('0)
(SETTYPE.N 0)
(VAR←↑ aPtrP)
('0)
(SETTYPE.N 128)
(VAR←↑ aFloatP)
('0)
(SETTYPE.N 192)
(VAR←↑ anXP)))
(* * one arg 0 -- should work unless other arg is bad)
(ShouldWork (0 0)
(0 23)
(32 0)
(0 -25)
(-52 0)
(T.MaxInt 0)
(0 T.MaxInt)
(T.MinInt 0)
(0 (ADD1 T.MinInt)))
[ShouldUFN ((QUOTE ((VAR aPtrP)))
0)
[0 (QUOTE ((VAR aPtrP]
((QUOTE ((VAR aFloatP)))
0)
[0 (QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
0)
(0 (QUOTE ((VAR anXP]
(* * two bad args)
[ShouldUFN [(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aFloatP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR anXP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aFloatP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR anXP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
(QUOTE ((VAR anXP]
(* * regular stuff)
(ShouldWork (12 23)
(34 -21)
(45 -45)
(56 -67))
(ShouldWork (-12 23)
(-34 34)
(-45 43)
(-45 -67))
(* * overflow edge testing)
[ShouldWork (T.MinInt -1)
((ADD1 T.MinInt)
1)
((PLUS T.MinInt 321)
320)
((PLUS T.MinInt 123)
123)
((LSH T.MinInt -1)
(IMINUS (LSH T.MinInt -1]
(ShouldUFN (T.MinInt 1)
((ADD1 T.MinInt)
2)
((PLUS T.MinInt 123)
124)
((PLUS T.MinInt 321)
736)
[(LSH T.MinInt -1)
(IMINUS (SUB1 (LSH T.MinInt -1]
(T.MinInt T.MinInt))
[ShouldWork (T.MaxInt 1)
((SUB1 T.MaxInt)
-1)
((DIFFERENCE T.MaxInt 769)
-768)
((DIFFERENCE T.MaxInt 123)
-123)
((LSH T.MaxInt -1)
(IMINUS (ADD1 (LSH T.MaxInt -1]
(ShouldUFN (T.MaxInt -1)
((SUB1 T.MaxInt)
-2)
((DIFFERENCE T.MaxInt 123)
-124)
((DIFFERENCE T.MaxInt 769)
-1125)
[(ADD1 (LSH T.MaxInt -1))
(IMINUS (ADD1 (LSH T.MaxInt -1]
(T.MaxInt T.MaxInt)))
('T)
(RETURN)))
(RPAQQ GreaterPTest1 ((LAMBDA: GreaterPTest1 NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE GREATERP))
(equivFn (QUOTE GREATERP)))
(* * make some non-integerPs)
(QUOTE (('0)
(SETTYPE.N 0)
(VAR←↑ aPtrP)
('0)
(SETTYPE.N 128)
(VAR←↑ aFloatP)
('0)
(SETTYPE.N 192)
(VAR←↑ anXP)))
(* * one bad arg)
[ShouldUFN ((QUOTE ((VAR aPtrP)))
0)
[0 (QUOTE ((VAR aPtrP]
((QUOTE ((VAR aFloatP)))
0)
[0 (QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
0)
(0 (QUOTE ((VAR anXP]
(* * two bad args)
[ShouldUFN [(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aFloatP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR anXP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aFloatP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR anXP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
(QUOTE ((VAR anXP]
(* * isn't supposed to overflow with integer arguments)
(ShouldNIL (T.MaxInt T.MaxInt))
(ShouldT (T.MaxInt (SUB1 T.MaxInt))
(T.MaxInt 245)
(T.MaxInt 1)
(T.MaxInt 0)
(T.MaxInt -1)
(T.MaxInt -5789)
(T.MaxInt (ADD1 T.MinInt))
(T.MaxInt T.MinInt))
(ShouldNIL ((SUB1 T.MaxInt)
T.MaxInt)
((SUB1 T.MaxInt)
(SUB1 T.MaxInt)))
(ShouldT ((SUB1 T.MaxInt)
(SUB1 (SUB1 T.MaxInt)))
((SUB1 T.MaxInt)
5789)
((SUB1 T.MaxInt)
1)
((SUB1 T.MaxInt)
0)
((SUB1 T.MaxInt)
-1)
((SUB1 T.MaxInt)
-4635)
((SUB1 T.MaxInt)
(ADD1 T.MinInt))
((SUB1 T.MaxInt)
T.MinInt))
(ShouldNIL (5789 T.MaxInt)
(5789 (SUB1 T.MaxInt))
(5789 5789))
(ShouldT (5789 (SUB1 5789))
(5789 1)
(5789 0)
(5789 -1)
(5789 -4635)
(5789 (ADD1 T.MinInt))
(5789 T.MinInt))
(ShouldNIL (1 T.MaxInt)
(1 (SUB1 T.MaxInt))
(1 5789)
(1 1))
(ShouldT (1 0)
(1 -1)
(1 -4635)
(1 (ADD1 T.MinInt))
(1 T.MinInt))
(ShouldNIL (0 T.MaxInt)
(0 (SUB1 T.MaxInt))
(0 5789)
(0 1)
(0 0))
(ShouldT (0 -1)
(0 -4635)
(0 (ADD1 T.MinInt))
(0 T.MinInt))
(ShouldNIL (-1 T.MaxInt)
(-1 (SUB1 T.MaxInt))
(-1 5789)
(-1 1)
(-1 0)
(-1 -1))
(ShouldT (-1 (SUB1 -1))
(-1 -4635)
(-1 (ADD1 T.MinInt))
(-1 T.MinInt))
(ShouldNIL (-4635 T.MaxInt)
(-4635 (SUB1 T.MaxInt))
(-4635 5789)
(-4635 1)
(-4635 0)
(-4635 -1)
(-4635 -4635))
(ShouldT (-4635 (SUB1 -4635))
(-4635 (ADD1 T.MinInt))
(-4635 T.MinInt))
(ShouldNIL ((ADD1 T.MinInt)
T.MaxInt)
((ADD1 T.MinInt)
(SUB1 T.MaxInt))
((ADD1 T.MinInt)
5789)
((ADD1 T.MinInt)
1)
((ADD1 T.MinInt)
0)
((ADD1 T.MinInt)
-1)
((ADD1 T.MinInt)
-4635)
((ADD1 T.MinInt)
(ADD1 T.MinInt)))
(ShouldT ((ADD1 T.MinInt)
T.MinInt))
(ShouldNIL (T.MinInt T.MaxInt)
(T.MinInt (SUB1 T.MaxInt))
(T.MinInt 5789)
(T.MinInt 1)
(T.MinInt 0)
(T.MinInt -1)
(T.MinInt -4635)
(T.MinInt (ADD1 T.MinInt))
(T.MinInt T.MinInt)))
('T)
(RETURN)))
(RPAQQ NegTest1 ((LAMBDA: NegTest1 NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE NEG))
(equivFn (QUOTE MINUS)))
(* * make some non-integerPs)
(QUOTE (('0)
(SETTYPE.N 0)
(VAR←↑ aPtrP)
('0)
(SETTYPE.N 128)
(VAR←↑ aFloatP)
('0)
(SETTYPE.N 192)
(VAR←↑ anXP)))
(* * non-integer arg)
[ShouldUFN [(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP]
(* * regular stuff)
(ShouldWork (T.MaxInt)
((SUB1 T.MaxInt))
((IDIFFERENCE T.MaxInt 43))
(57)
(1)
(0)
(-1)
(-72)
((IPLUS T.MinInt 35))
((ADD1 T.MinInt)))
(* * overflow edge testing)
(ShouldUFN (T.MinInt)))
('T)
(RETURN)))
(* (StdUfn (QUOTE PLUS) 2) (StdUfn (QUOTE DIFFERENCE) 2) (StdUfn (QUOTE GREATERP) 2) (StdUfn (
QUOTE NEG) 1))
(RPAQQ ArithUfnTest1 ((LAMBDA: ArithUfnTest1 NIL)
(VARS: arg1 arg2)
CODE:
[MakeTest (testOpCode)
(PROGN (SETQ testOpCode (QUOTE TIMES))
(ShouldUFN (1 2)))
(PROGN (SETQ testOpCode (QUOTE QUOTIENT))
(ShouldUFN (1 2)))
(PROGN (SETQ testOpCode (QUOTE ITIMES))
(ShouldUFN (1 2)))
(PROGN (SETQ testOpCode (QUOTE IQUOTIENT))
(ShouldUFN (1 2)))
(PROGN (SETQ testOpCode (QUOTE IREMAINDER))
(ShouldUFN (1 2]
('T)
(RETURN)))
(* (PROGN (StdUfn (QUOTE TIMES) 2) (StdUfn (QUOTE QUOTIENT) 2) (StdUfn (QUOTE ITIMES) 2) (
StdUfn (QUOTE IQUOTIENT) 2) (StdUfn (QUOTE IREMAINDER) 2)))
(* * LOG OPCODES -- status: -- LOGAND LOGOR LOGXOR ok)
(RPAQQ LogAndTest1 ((LAMBDA: LogAndTest1 NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE LOGAND))
(equivFn (QUOTE LOGAND)))
(* * should ufn -- non-integerps)
[ShouldUFN [0 (QUOTE ((VAR aPtrP]
[0 (QUOTE ((VAR aFloatP]
(0 (QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR aPtrP)))
0)
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR aPtrP)))
(QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR aFloatP)))
0)
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR aFloatP)))
(QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR anXP)))
0)
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
(QUOTE ((VAR anXP]
(* * regular stuff)
(ShouldWork (T.MinInt T.MinInt)
(T.MinInt (IPLUS T.MinInt 302))
(T.MinInt -1)
(T.MinInt 0)
(T.MinInt 1)
(T.MinInt (IDIFFERENCE T.MaxInt 411))
(T.MinInt T.MaxInt))
(ShouldWork ((IPLUS T.MinInt 302)
T.MinInt)
((IPLUS T.MinInt 302)
(IPLUS T.MinInt 302))
((IPLUS T.MinInt 302)
-1)
((IPLUS T.MinInt 302)
0)
((IPLUS T.MinInt 302)
1)
((IPLUS T.MinInt 302)
(IDIFFERENCE T.MaxInt 411))
((IPLUS T.MinInt 302)
T.MaxInt))
(ShouldWork (-1 T.MinInt)
(-1 (IPLUS T.MinInt 302))
(-1 -1)
(-1 0)
(-1 1)
(-1 (IDIFFERENCE T.MaxInt 411))
(-1 T.MaxInt))
(ShouldWork (0 T.MinInt)
(0 (IPLUS T.MinInt 302))
(0 -1)
(0 0)
(0 1)
(0 (IDIFFERENCE T.MaxInt 411))
(0 T.MaxInt))
(ShouldWork (1 T.MinInt)
(1 (IPLUS T.MinInt 302))
(1 -1)
(1 0)
(1 1)
(1 (IDIFFERENCE T.MaxInt 411))
(1 T.MaxInt))
(ShouldWork ((IDIFFERENCE T.MaxInt 411)
T.MinInt)
((IDIFFERENCE T.MaxInt 411)
(IPLUS T.MinInt 302))
((IDIFFERENCE T.MaxInt 411)
-1)
((IDIFFERENCE T.MaxInt 411)
0)
((IDIFFERENCE T.MaxInt 411)
1)
((IDIFFERENCE T.MaxInt 411)
(IDIFFERENCE T.MaxInt 411))
((IDIFFERENCE T.MaxInt 411)
T.MaxInt))
(ShouldWork (T.MaxInt T.MinInt)
(T.MaxInt (IPLUS T.MinInt 302))
(T.MaxInt -1)
(T.MaxInt 0)
(T.MaxInt 1)
(T.MaxInt (IDIFFERENCE T.MaxInt 411))
(T.MaxInt T.MaxInt)))
('T)
(RETURN)))
(RPAQQ LogOrTest1 ((LAMBDA: LogOrTest1 NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE LOGOR))
(equivFn (QUOTE LOGOR)))
(* * should ufn -- non-integerps)
[ShouldUFN [0 (QUOTE ((VAR aPtrP]
[0 (QUOTE ((VAR aFloatP]
(0 (QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR aPtrP)))
0)
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR aPtrP)))
(QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR aFloatP)))
0)
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR aFloatP)))
(QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR anXP)))
0)
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
(QUOTE ((VAR anXP]
(* * regular stuff)
(ShouldWork (T.MinInt T.MinInt)
(T.MinInt (IPLUS T.MinInt 302))
(T.MinInt -1)
(T.MinInt 0)
(T.MinInt 1)
(T.MinInt (IDIFFERENCE T.MaxInt 411))
(T.MinInt T.MaxInt))
(ShouldWork ((IPLUS T.MinInt 302)
T.MinInt)
((IPLUS T.MinInt 302)
(IPLUS T.MinInt 302))
((IPLUS T.MinInt 302)
-1)
((IPLUS T.MinInt 302)
0)
((IPLUS T.MinInt 302)
1)
((IPLUS T.MinInt 302)
(IDIFFERENCE T.MaxInt 411))
((IPLUS T.MinInt 302)
T.MaxInt))
(ShouldWork (-1 T.MinInt)
(-1 (IPLUS T.MinInt 302))
(-1 -1)
(-1 0)
(-1 1)
(-1 (IDIFFERENCE T.MaxInt 411))
(-1 T.MaxInt))
(ShouldWork (0 T.MinInt)
(0 (IPLUS T.MinInt 302))
(0 -1)
(0 0)
(0 1)
(0 (IDIFFERENCE T.MaxInt 411))
(0 T.MaxInt))
(ShouldWork (1 T.MinInt)
(1 (IPLUS T.MinInt 302))
(1 -1)
(1 0)
(1 1)
(1 (IDIFFERENCE T.MaxInt 411))
(1 T.MaxInt))
(ShouldWork ((IDIFFERENCE T.MaxInt 411)
T.MinInt)
((IDIFFERENCE T.MaxInt 411)
(IPLUS T.MinInt 302))
((IDIFFERENCE T.MaxInt 411)
-1)
((IDIFFERENCE T.MaxInt 411)
0)
((IDIFFERENCE T.MaxInt 411)
1)
((IDIFFERENCE T.MaxInt 411)
(IDIFFERENCE T.MaxInt 411))
((IDIFFERENCE T.MaxInt 411)
T.MaxInt))
(ShouldWork (T.MaxInt T.MinInt)
(T.MaxInt (IPLUS T.MinInt 302))
(T.MaxInt -1)
(T.MaxInt 0)
(T.MaxInt 1)
(T.MaxInt (IDIFFERENCE T.MaxInt 411))
(T.MaxInt T.MaxInt)))
('T)
(RETURN)))
(RPAQQ LogXorTest1 ((LAMBDA: LogXorTest1 NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE LOGXOR))
(equivFn (QUOTE LOGXOR)))
(* * should ufn -- non-integerps)
[ShouldUFN [0 (QUOTE ((VAR aPtrP]
[0 (QUOTE ((VAR aFloatP]
(0 (QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR aPtrP)))
0)
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR aPtrP)))
(QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR aFloatP)))
0)
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR aFloatP)))
(QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR anXP)))
0)
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
(QUOTE ((VAR anXP]
(* * regular stuff)
(ShouldWork (T.MinInt T.MinInt)
(T.MinInt (IPLUS T.MinInt 302))
(T.MinInt -1)
(T.MinInt 0)
(T.MinInt 1)
(T.MinInt (IDIFFERENCE T.MaxInt 411))
(T.MinInt T.MaxInt))
(ShouldWork ((IPLUS T.MinInt 302)
T.MinInt)
((IPLUS T.MinInt 302)
(IPLUS T.MinInt 302))
((IPLUS T.MinInt 302)
-1)
((IPLUS T.MinInt 302)
0)
((IPLUS T.MinInt 302)
1)
((IPLUS T.MinInt 302)
(IDIFFERENCE T.MaxInt 411))
((IPLUS T.MinInt 302)
T.MaxInt))
(ShouldWork (-1 T.MinInt)
(-1 (IPLUS T.MinInt 302))
(-1 -1)
(-1 0)
(-1 1)
(-1 (IDIFFERENCE T.MaxInt 411))
(-1 T.MaxInt))
(ShouldWork (0 T.MinInt)
(0 (IPLUS T.MinInt 302))
(0 -1)
(0 0)
(0 1)
(0 (IDIFFERENCE T.MaxInt 411))
(0 T.MaxInt))
(ShouldWork (1 T.MinInt)
(1 (IPLUS T.MinInt 302))
(1 -1)
(1 0)
(1 1)
(1 (IDIFFERENCE T.MaxInt 411))
(1 T.MaxInt))
(ShouldWork ((IDIFFERENCE T.MaxInt 411)
T.MinInt)
((IDIFFERENCE T.MaxInt 411)
(IPLUS T.MinInt 302))
((IDIFFERENCE T.MaxInt 411)
-1)
((IDIFFERENCE T.MaxInt 411)
0)
((IDIFFERENCE T.MaxInt 411)
1)
((IDIFFERENCE T.MaxInt 411)
(IDIFFERENCE T.MaxInt 411))
((IDIFFERENCE T.MaxInt 411)
T.MaxInt))
(ShouldWork (T.MaxInt T.MinInt)
(T.MaxInt (IPLUS T.MinInt 302))
(T.MaxInt -1)
(T.MaxInt 0)
(T.MaxInt 1)
(T.MaxInt (IDIFFERENCE T.MaxInt 411))
(T.MaxInt T.MaxInt)))
('T)
(RETURN)))
(* (StdUfn (QUOTE LOGAND) 2) (StdUfn (QUOTE LOGOR) 2) (StdUfn (QUOTE LOGXOR) 2))
(* * SHIFT OPCODES -- ASH LLSH.N LRSH.N OK)
(RPAQQ LlshNTest1 ((LAMBDA: LlshNTest1 NIL)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
[MakeTest [(testOpCode (QUOTE LLSH.N))
(equivFn (FUNCTION (LAMBDA (N V)
(LLSH V N]
(* * NOTE that args are presented here: N V)
(* * can shift 0 left any amount)
(ShouldWork.N (0 0)
(1 0)
(29 0)
(30 0)
(31 0)
(32 0)
(33 0)
(255 0))
(* * can shift positive numbers iff the sign bit of the <temp>result
isn't affected)
(ShouldWork.N (0 1)
(1 1)
(20 1)
(28 1))
(ShouldUFN.N (29 1)
(31 1))
(ShouldWork.N (0 37)
(1 37)
(3 37)
(21 37)
(23 37))
(ShouldUFN.N (24 37)
(27 37))
(ShouldWork.N (0 (LRSH T.MaxInt 1))
(1 (LRSH T.MaxInt 1)))
(ShouldUFN.N (2 (LRSH T.MaxInt 1))
(5 (LRSH T.MaxInt 1)))
(ShouldWork.N (0 T.MaxInt))
(ShouldUFN.N (1 T.MaxInt)
(3 T.MaxInt))
(* * can't shift negative numbers)
(ShouldUFN.N (0 -1)
(3 -1)
(0 T.MinInt)
(3 T.MinInt))
(* * can't shift non-FixNums)
(ShouldUFN.N [0 (QUOTE (('0)
(SETTYPE.N 0]
[0 (QUOTE (('0)
(SETTYPE.N 128]
(0 (QUOTE (('0)
(SETTYPE.N 192]
('T)
(RETURN)))
(RPAQQ LrshNTest1 ((LAMBDA: LrshNTest1 NIL)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
[MakeTest [(testOpCode (QUOTE LRSH.N))
(equivFn (FUNCTION (LAMBDA (N V)
(LRSH (LOGAND (MASK.1'S 0 30)
V)
N]
(* * NOTE that args are presented here: N V)
(* * can shift any numbers right any amount)
(ShouldWork.N (0 0)
(255 0))
(ShouldWork.N (0 1)
(1 1)
(20 1))
(ShouldWork.N (0 37)
(1 37)
(5 37)
(6 37))
(ShouldWork.N (0 (LRSH T.MaxInt 1))
(1 (LRSH T.MaxInt 1))
(27 (LRSH T.MaxInt 1))
(28 (LRSH T.MaxInt 1)))
(ShouldWork.N (0 T.MaxInt)
(1 T.MaxInt)
(28 T.MaxInt)
(29 T.MaxInt))
(ShouldWork.N (0 -1)
(14 -1)
(29 -1)
(30 -1))
(ShouldWork.N (0 -478)
(14 -478)
(29 -478)
(30 -478))
(ShouldWork.N (0 T.MinInt)
(14 T.MinInt)
(29 T.MinInt)
(30 T.MinInt))
(* * can't shift non-FixNums)
(ShouldUFN.N [0 (QUOTE (('0)
(SETTYPE.N 0]
[0 (QUOTE (('0)
(SETTYPE.N 128]
(0 (QUOTE (('0)
(SETTYPE.N 192]
('T)
(RETURN)))
(RPAQQ AshTest1 ((LAMBDA: AshTest1 NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
[MakeTest ((testOpCode (QUOTE ASH))
(equivFn (QUOTE LSH)))
(* * can shift any numbers right up to 29)
(ShouldWork (0 0)
(0 -29))
(ShouldUFN (0 -30))
(ShouldWork (1 0)
(1 -1)
(1 -29))
(ShouldUFN (1 -30))
(ShouldWork (37 0)
(37 -1)
(37 -5)
(37 -6)
(37 -29))
(ShouldUFN (37 -30))
(ShouldWork ((LRSH T.MaxInt 1)
0)
((LRSH T.MaxInt 1)
-1)
((LRSH T.MaxInt 1)
-27)
((LRSH T.MaxInt 1)
-28)
((LRSH T.MaxInt 1)
-29))
(ShouldUFN ((LRSH T.MaxInt 1)
-30))
(ShouldWork (T.MaxInt 0)
(T.MaxInt -1)
(T.MaxInt -28)
(T.MaxInt -29))
(ShouldUFN (T.MaxInt -30))
(ShouldWork (-1 -14)
(-1 -29))
(ShouldUFN (-1 -30))
(ShouldWork (-478 -14)
(-478 -29))
(ShouldUFN (-478 -30))
(ShouldWork (T.MinInt -14)
(T.MinInt -29))
(ShouldUFN (T.MinInt -30))
(* * can shift non-negative numbers left up to 29 times OR until the
sign bit of the <temp>result is affected)
(ShouldWork (0 0)
(0 1)
(0 29))
(ShouldUFN (0 30))
(ShouldWork (1 0)
(1 1)
(1 20)
(1 28))
(ShouldUFN (1 29)
(1 30))
(ShouldWork (37 0)
(37 1)
(37 3)
(37 21)
(37 23))
(ShouldUFN (37 24)
(37 27))
(ShouldWork ((LRSH T.MaxInt 1)
0)
((LRSH T.MaxInt 1)
1))
(ShouldUFN ((LRSH T.MaxInt 1)
2)
((LRSH T.MaxInt 1)
5))
(ShouldWork (T.MaxInt 0))
(ShouldUFN (T.MaxInt 1)
(T.MaxInt 3))
(* * can't shift negative numbers left at all)
(ShouldUFN (-1 0)
(-1 5)
(-1 30)
(T.MinInt 0)
(T.MinInt 5)
(T.MinInt 30))
(* * can't shift non-FixNums or by non-FixNums)
(QUOTE (('0)
(SETTYPE.N 0)
(VAR←↑ aPtrP)
('0)
(SETTYPE.N 128)
(VAR←↑ aFloatP)
('0)
(SETTYPE.N 192)
(VAR←↑ anXP)))
[ShouldUFN [0 (QUOTE ((VAR aPtrP]
[0 (QUOTE ((VAR aFloatP]
(0 (QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR aPtrP)))
0)
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aPtrP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR aPtrP)))
(QUOTE ((VAR anXP]
[ShouldUFN ((QUOTE ((VAR aFloatP)))
0)
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR aFloatP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR aFloatP)))
(QUOTE ((VAR anXP]
(ShouldUFN ((QUOTE ((VAR anXP)))
0)
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aPtrP]
[(QUOTE ((VAR anXP)))
(QUOTE ((VAR aFloatP]
((QUOTE ((VAR anXP)))
(QUOTE ((VAR anXP]
('T)
(RETURN)))
(* (StdUfn (QUOTE LLSH.N) 2) (StdUfn (QUOTE LRSH.N) 2) (StdUfn (QUOTE ASH) 2))
(* * TYPE, CONSTANT, AND EQUALITY OPCODES)
(* * status of TypeTest1 -- either make GETPTRBITS work on non-PointerPs or change the
GETPTRBITS in TypeTest1.1 to something like <if pointerp then getptrbits else
settype.n←integerp)
(* * PUTxx, GETxx and the constant opcodes ICONST `0 `1 SICX SICXXX PCONST ACONST 'T 'NIL
'UNBOUND FCONST XCONST)
(DEFINEQ
(DoTypeTest1
[LAMBDA NIL (* jmh "26-Jun-86 14:54")
(TASMV (QUOTE TypeTest1))
(TPUTD (QUOTE TypeTest1))
(TASMV (QUOTE TypeTest1.1))
(TPUTD (QUOTE TypeTest1.1))
(StdUfn (QUOTE GETTYPEBITS)
1)
(StdUfn (QUOTE GETPTRBITS)
1)
(TRun doTypeTest1])
)
(RPAQQ doTypeTest1 ((* * PCONST, ACONST don't ASM right -- so this is to be TRun)
PCONST 0 0 0 0 SICX 0 SICX 0 FN3 TypeTest1.1 (*)
PCONST 120 86 52 18 SICX 18 ICONST 120 86 52 0 FN3 TypeTest1.1 (*)
PCONST 152 186 220 254 SICX 62 ICONST 152 186 220 0 FN3 TypeTest1.1 (*)
PCONST 255 255 255 255 SICX 63 ICONST 255 255 255 0 FN3 TypeTest1.1 (*)
ACONST 86 52 18 SICX 8 ICONST 86 52 18 0 FN3 TypeTest1.1 (*)
(* * now test everybody else)
FN0 TypeTest1))
(RPAQQ doTypeTest1A ((* * PCONST, ACONST don't ASM right -- so this is to be TRun)
PCONST 152 186 220 254 SICX 62 ICONST 152 186 220 0 FN3 TypeTest1.1 (*)
PCONST 255 255 255 255 SICX 63 ICONST 255 255 255 0 FN3 TypeTest1.1 (*)
ACONST 86 52 18 SICX 8 ICONST 86 52 18 0 FN3 TypeTest1.1 (*)
(* * now test everybody else)
FN0 TypeTest1))
(RPAQQ TypeTest1 ((LAMBDA: TypeTest1 NIL)
CODE:
(StackCheck (ICONST 0)
(SIC 64)
(SIC 0)
(FN3 TypeTest1.1)
(POP)
(ICONST 305419896)
(SIC 82)
(SIC 3430008)
(FN3 TypeTest1.1)
(POP)
(ICONST -19088744)
(SIC 62)
(SIC 14465688)
(FN3 TypeTest1.1)
(POP)
(ICONST -1)
(SIC 63)
(SIC 16777215)
(FN3 TypeTest1.1)
(POP))
(StackCheck ('0)
(ICONST 0)
(EQ)
(ElseStop)
('1)
(ICONST 1)
(EQ)
(ElseStop)
(SIC 0)
(ICONST 0)
(EQ)
(ElseStop)
(SIC 255)
(ICONST 255)
(EQ)
(ElseStop)
(SIC 4660)
(ICONST 4660)
(EQ)
(ElseStop)
(SIC 65244)
(ICONST 65244)
(EQ)
(ElseStop))
(* * PCONST, ACONST tested elsewhere)
(StackCheck ('NIL)
(SIC 8)
(SIC 0)
(FN3 TypeTest1.1)
(POP)
('T)
(SIC 8)
(SIC 1)
(FN3 TypeTest1.1)
(POP)
('UNBOUND)
(SIC 2)
(SIC 0)
(FN3 TypeTest1.1)
(POP))
(StackCheck (FCONST 0 0 0 0)
(SIC 64)
(SIC 0)
(FN3 TypeTest1.1)
(POP)
(FCONST 120 86 52 18)
(SIC 82)
(SIC 3430008)
(FN3 TypeTest1.1)
(POP)
(FCONST 135 169 203 237)
(SIC 62)
(SIC 13347207)
(FN3 TypeTest1.1)
(POP)
(FCONST 255 255 255 255)
(SIC 63)
(SIC 16777215)
(FN3 TypeTest1.1)
(POP))
(StackCheck (XCONST 0 0 0 0)
(SIC 64)
(SIC 0)
(FN3 TypeTest1.1)
(POP)
(XCONST 120 86 52 18)
(SIC 82)
(SIC 3430008)
(FN3 TypeTest1.1)
(POP)
(XCONST 135 169 203 237)
(SIC 62)
(SIC 13347207)
(FN3 TypeTest1.1)
(POP)
(XCONST 135 169 203 237)
(SIC 63)
(SIC 16777215)
(FN3 TypeTest1.1)
(POP))))
(RPAQQ TypeTest1.1 ((LAMBDA: TypeTest1.1 (x typeBits ptrBits))
(VARS: x typeBits ptrBits)
CODE:
(StackCheck (VAR x)
(GETTYPEBITS)
(VAR typeBits)
(EQ)
(ElseStop)
(VAR x)
(GETPTRBITS)
(VAR ptrBits)
(EQ)
(ElseStop)
(VAR ptrBits)
(VAR typeBits)
(SETSUBTYPE)
(VAR x)
(EQ)
(ElseStop))
('T)
(RETURN)))
(* * status of TypeTest2 -- still trying to get the code of TypeTest2.3ptr right -- may have
GETPTRBITS problems like TypeTest1, too)
(* * test everything else -- except EQUAL CEQUAL which supposedly share ucode with EQP)
(DEFINEQ
(DoTypeTest2
[LAMBDA NIL (* jmh "26-Jun-86 16:35")
(for fn in (QUOTE (TypeTest2 TypeTest2.1 TypeTest2.2 TypeTest2.3type TypeTest2.3ptr))
do (TASMV fn)
(TPUTD fn))
(for x in (QUOTE ((INTEGERP 1)
(FLOATP 1)
(POINTERP 1)
(XTYPEP 1)
(CONSP 1)
(SUBTYPEP.N 2)
(FLAGTYPEP.N 2)
(GETTYPEBITS 1)
(GETPTRBITS 1)
(SETTYPE.N 2)
(SETSUBTYPE 2)
(EQL 2)
(EQP 2)))
do (APPLY (QUOTE StdUfn)
x))
(TRun (QUOTE (FN0 TypeTest2])
)
(RPAQQ TypeTest2 ((LAMBDA: TypeTest2 NIL)
CODE:
(* * loop on some pointerBits)
(SIC 0)
(FN1 TypeTest2.1)
(SIC 1)
(FN1 TypeTest2.1)
(SIC 305419896)
(FN1 TypeTest2.1)
(SIC 536870911)
(FN1 TypeTest2.1)
(SIC -1)
(FN1 TypeTest2.1)
(SIC 1072548777)
(FN1 TypeTest2.1)
(SIC 536870912)
(FN1 TypeTest2.1)
('T)
(RETURN)))
(RPAQQ TypeTest2.1 ((LAMBDA: TypeTest2.1 (ptrBits))
(VARS: ptrBits)
CODE:
(* * for each ptrBits, do for each type)
(VAR ptrBits)
(SETTYPE.N 0)
(FN1 TypeTest2.2)
(VAR ptrBits)
(SETTYPE.N 64)
(FN1 TypeTest2.2)
(VAR ptrBits)
(SETTYPE.N 128)
(FN1 TypeTest2.2)
(VAR ptrBits)
(SETTYPE.N 192)
(FN1 TypeTest2.2)
('T)
(RETURN)))
(RPAQQ TypeTest2.2 ((LAMBDA: TypeTest2.2 (x))
(VARS: x)
CODE:
(* * check EQ etc succeed)
(StackCheck (VAR x)
(GETPTRBITS)
(VAR x)
(GETTYPEBITS)
(SETSUBTYPE)
(VAR x)
(EQ)
(ElseStop))
(StackCheck (VAR x)
(GETPTRBITS)
(VAR x)
(GETTYPEBITS)
(SETSUBTYPE)
(VAR x)
(EQL)
(ElseStop))
(StackCheck (VAR x)
(GETPTRBITS)
(VAR x)
(GETTYPEBITS)
(SETSUBTYPE)
(VAR x)
(EQP)
(ElseStop))
(* * test NEQ etc of 1-bit mod of type)
(VAR x)
(SIC 128)
(FN2 TypeTest2.3type)
(VAR x)
(SIC 64)
(FN2 TypeTest2.3type)
(VAR x)
(SIC 32)
(FN2 TypeTest2.3type)
(VAR x)
(SIC 4)
(FN2 TypeTest2.3type)
(VAR x)
(SIC 2)
(FN2 TypeTest2.3type)
(VAR x)
(SIC 1)
(FN2 TypeTest2.3type)
(* * test NEQ etc of 1-bit mod of pointer)
(VAR x)
(SIC 8388608)
(FN2 TypeTest2.3ptr)
(VAR x)
(SIC 1)
(FN2 TypeTest2.3ptr)
('T)
(RETURN)))
(RPAQQ TypeTest2.3type ((LAMBDA: TypeTest2.3type (x mask))
(VARS: x mask)
(VARS: y)
CODE:
(* * check the equality opcodes on x after twiddling type bits with mask)
(VAR x)
(COPY)
(GETTYPEBITS)
(VAR mask)
(LOGXOR)
(SETSUBTYPE)
(VAR← y)
(StackCheck (VAR x)
(VAR y)
(EQ)
(IfStop))
(StackCheck (VAR x)
(VAR y)
(EQL)
(IfStop))
(StackCheck (VAR x)
(VAR y)
(EQP)
(ACONST EQP)
(VAR x)
(VAR y)
(FN4 CheckUfn)
(POP))
('T)
(RETURN)))
(RPAQQ TypeTest2.3ptr ((LAMBDA: TypeTest2.3ptr (x mask))
(VARS: x mask)
(VARS: y)
CODE:
(* * check the equality opcodes on x after twiddling pointer bits with mask)
(* * make y)
(VAR x)
(SETTYPE.N 64)
(VAR mask)
(LOGXOR)
(VAR x)
(GETTYPEBITS)
(SETSUBTYPE)
(VAR← y)
(* * EQ)
(StackCheck (VAR x)
(VAR y)
(EQ)
(IfStop))
(* * EQL)
(VAR x)
(FLAGTYPEP.N 3)
(FJUMP notBothNumberP)
bothNumberP
(StackCheck (VAR x)
(VAR y)
(EQL)
(ACONST EQL)
(VAR x)
(VAR y)
(FN4 CheckUfn)
(POP))
(JUMP EQLdone)
notBothNumberP
(StackCheck (VAR x)
(VAR y)
(EQL)
(IfStop))
EQLdone
(* * EQP)
(StackCheck (VAR x)
(VAR y)
(EQP)
(ACONST EQP)
(VAR x)
(VAR y)
(FN4 CheckUfn)
(POP))
('T)
(RETURN)))
(PUTPROPS TUT1 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (30318 30720 (DoTypeTest1 30328 . 30718)) (34012 34685 (DoTypeTest2 34022 . 34683)))))
STOP