(FILECREATED "16-Jul-86 10:57:48" {ERIS}<TAMARIN>UCODE>TUT1.;1 41570
changes to: (VARS DiffTest1 TypeTest2.2 TypeTest2.3ptr)
(FNS DoTypeTest2)
previous date: "26-Jun-86 15:30:31" {ERIS}<TAMARIN>TUT>TUT1.;24)
(* 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 NEG ok -- DIFFERENCE needs
still: DiffTest1A GreaterPTest1A; used to be: DIFFERENCE ufns if
sgn{leftOp}<>sgn{result} -- GREATERP needs a GreaterPTest1A from <T.MinInt 1>
on; I don't know current ufn conditions; used to give wrong answer if
leftOp>=0,rightOp<0 -- IPLUS IDIFFERENCE IGREATERP supposed to share PLUS
DIFFERENCE GREATERP ucode, untested)
(VARS PlusTest1 DiffTest1 DiffTest1A GreaterPTest1 GreaterPTest1A 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)
(* * PUTxx, GETxx and the constant opcodes ICONST `0 `1 SICX SICXXX PCONST ACONST
'T 'NIL 'UNBOUND FCONST XCONST)
(FNS DoTypeTest1)
(VARS doTypeTest1)
(VARS TypeTest1 TypeTest1.1)
(* * 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 NEG ok -- DIFFERENCE needs still:
DiffTest1A GreaterPTest1A; used to be: DIFFERENCE ufns if sgn{leftOp}<>sgn{result} -- GREATERP
needs a GreaterPTest1A from <T.MinInt 1> on; I don't know current ufn conditions; used to give
wrong answer if leftOp>=0,rightOp<0 -- 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 DiffTest1A ((LAMBDA: DiffTest1A NIL)
(VARS: aPtrP aFloatP anXP)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE DIFFERENCE))
(equivFn (QUOTE DIFFERENCE)))
(ShouldUFN [(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 GreaterPTest1A ((LAMBDA: GreaterPTest1A NIL)
(VARS: arg1 arg2)
CODE:
(* jmh " 5-Jun-86 17:01")
(MakeTest ((testOpCode (QUOTE GREATERP))
(equivFn (QUOTE GREATERP)))
(* * 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)
(* * 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 64 SICX 0 FN3 TypeTest1.1 (*)
PCONST 120 86 52 18 SICX 82 ICONST 120 86 52 18 FN3 TypeTest1.1 (*)
PCONST 152 186 220 254 SICX 62 ICONST 152 186 220 254 FN3 TypeTest1.1 (*)
PCONST 255 255 255 255 SICX 64 ICONST 255 255 255 255 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)))
(* * test everything else -- except EQUAL CEQUAL which supposedly share ucode with EQP)
(DEFINEQ
(DoTypeTest2
[LAMBDA NIL (* rtk "26-Jun-86 16:24")
(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)
(COPY)
(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 (33964 34366 (DoTypeTest1 33974 . 34364)) (37139 37812 (DoTypeTest2 37149 . 37810)))))
STOP