(FILECREATED "27-Jan-86 16:12:31" {ERINYES}<HERRING>COMPILER>D2DTESTSUITE.;7 10658
changes to: (FNS D2DTS.IPFLS)
previous date: " 9-Dec-85 12:43:12" {ERINYES}<HERRING>COMPILER>D2DTESTSUITE.;6)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT D2DTESTSUITECOMS)
(RPAQQ D2DTESTSUITECOMS [(* * static tests of fn types and var allocn)
(FNS D2DTS.L0 D2DTS.L1LI D2DTS.L2LI D2DTS.L3LI D2DTS.L4LI D2DTS.L5LI
D2DTS.L6LI D2DTS.L7LI D2DTS.L8LI)
(FNS D2DTS.L1SI D2DTS.L3SI D2DTS.L4SI D2DTS.L5SI D2DTS.L6SI D2DTS.L7SI
D2DTS.L8SI)
(FNS D2DTS.N0 D2DTS.N1LI)
(FNS D2DTS.IPFLS)
(FNS D2DTS.APPLY D2DTS.SIC D2DTS.APPLY*0)
(* * dynamic tests)
(FNS D2DTS.N*)
(FNS D2DTS.L*A D2DTS.L*0 D2DTS.L*S D2DTS.L*C)
(FNS D2DTS.B0)
(FNS D2DTS.FNS)
(* * utilities)
(FNS DONOTHING LISTOFARGS)
(MACROS inc)
(* * test drivers)
(FNS COMPAREFN)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA D2DTS.N*)
(NLAML D2DTS.N1LI D2DTS.N0)
(LAMA LISTOFARGS D2DTS.L*C D2DTS.L*S D2DTS.L*0 D2DTS.L*A])
(* * static tests of fn types and var allocn)
(DEFINEQ
(D2DTS.L0
[LAMBDA NIL (* jmh "25-Nov-85 18:34")
(* * 0 ivar lambda -- 0 locals -- 0 specvars -- GCONST RETURN -X-)
(QUOTE hi!])
(D2DTS.L1LI
[LAMBDA (I1) (* jmh "25-Nov-85 18:27")
(* * 1 ivar lambda -- 1 locals -- 0 specvars -- FN0 IVARk 'NIL CONS)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1])
(D2DTS.L2LI
[LAMBDA (I1 I2) (* jmh "25-Nov-85 18:27")
(* * 2 ivar lambda -- 2 locals -- 0 specvars)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1 I2])
(D2DTS.L3LI
[LAMBDA (I1 I2 I3) (* jmh "25-Nov-85 18:27")
(* * 3 ivar lambda -- 3 locals -- 0 specvars)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1 I2 I3])
(D2DTS.L4LI
[LAMBDA (I1 I2 I3 I4) (* jmh "25-Nov-85 18:27")
(* * 4 ivar lambda -- 4 locals -- 0 specvars)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4])
(D2DTS.L5LI
[LAMBDA (I1 I2 I3 I4 I5) (* jmh "25-Nov-85 18:28")
(* * 5 ivar lambda -- 5 locals -- 0 specvars)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4 I5])
(D2DTS.L6LI
[LAMBDA (I1 I2 I3 I4 I5 I6) (* jmh "25-Nov-85 18:28")
(* * 6 ivar lambda -- <7 ivars -- 6 locals -- 0 specvars)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4 I5 I6])
(D2DTS.L7LI
[LAMBDA (I1 I2 I3 I4 I5 I6 I7) (* jmh "25-Nov-85 18:28")
(* * 7 ivar lambda -- >6 ivars -- 7 locals -- 0 specvars)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4 I5 I6 I7])
(D2DTS.L8LI
[LAMBDA (I1 I2 I3 I4 I5 I6 I7 I8) (* jmh "25-Nov-85 18:28")
(* * 8 ivar lambda -- >6 ivars -- 8 locals -- 0 specvars)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4 I5 I6 I7 I8])
)
(DEFINEQ
(D2DTS.L1SI
[LAMBDA (I1) (* jmh "25-Nov-85 18:33")
(* * 1 ivar lambda -- 1 specvars -- 0 locals)
(DECLARE (SPECVARS . T))
(DONOTHING)
(LIST I1])
(D2DTS.L3SI
[LAMBDA (I1 I2 I3) (* jmh "25-Nov-85 18:33")
(* * 3 ivar lambda -- 3 specvars -- 0 locals)
(DECLARE (SPECVARS . T))
(DONOTHING)
(LIST I1 I2 I3])
(D2DTS.L4SI
[LAMBDA (I1 I2 I3 I4) (* jmh "25-Nov-85 18:32")
(* * 4 ivar lambda -- 4 specvars -- 0 locals)
(DECLARE (SPECVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4])
(D2DTS.L5SI
[LAMBDA (I1 I2 I3 I4 I5) (* jmh "25-Nov-85 18:32")
(* * 5 ivar lambda -- 5 specvars -- 0 locals)
(DECLARE (SPECVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4 I5])
(D2DTS.L6SI
[LAMBDA (I1 I2 I3 I4 I5 I6) (* jmh "25-Nov-85 18:32")
(* * 6 ivar lambda -- <7 ivars -- 6 specvars -- 0 locals)
(DECLARE (SPECVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4 I5 I6])
(D2DTS.L7SI
[LAMBDA (I1 I2 I3 I4 I5 I6 I7) (* jmh "25-Nov-85 18:29")
(* * 7 ivar lambda -- >6 ivars -- 7 specvars -- 0 locals)
(DECLARE (SPECVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4 I5 I6 I7])
(D2DTS.L8SI
[LAMBDA (I1 I2 I3 I4 I5 I6 I7 I8) (* jmh "25-Nov-85 18:32")
(* * 8 ivar lambda -- >6 ivars -- 8 specvars -- 0 locals)
(DECLARE (SPECVARS . T))
(DONOTHING)
(LIST I1 I2 I3 I4 I5 I6 I7 I8])
)
(DEFINEQ
(D2DTS.N0
[NLAMBDA NIL (* jmh "25-Nov-85 18:34")
(* * 0 ivar nlambda)
(QUOTE hi!])
(D2DTS.N1LI
[NLAMBDA (I1) (* jmh " 8-Dec-85 15:52")
(* * 1 ivar nlambda -- 1 locals -- 0 specvars)
(DECLARE (LOCALVARS . T))
(DONOTHING)
(LIST I1])
)
(DEFINEQ
(D2DTS.IPFLS
[LAMBDA (IL IS) (* jmh "25-Jan-86 18:49")
(* * 1 each local /specvar x ivar /pvar -- 1 fvar)
(DECLARE (LOCALVARS IL)
(SPECVARS IS)
(USEDFREE FV))
(LET (PL PS)
(DECLARE (LOCALVARS PL)
(SPECVARS PS))
(SETQ PL (DONOTHING))
(LISTOFARGS IL IS PL PS FV])
)
(DEFINEQ
(D2DTS.APPLY
[LAMBDA NIL
(* * test APPLY)
(LIST (APPLY (QUOTE LISTOFARGS)
(QUOTE NIL))
(APPLY (QUOTE LISTOFARGS)
(QUOTE (1 2 3])
(D2DTS.SIC
[LAMBDA NIL (* jmh " 9-Dec-85 12:07")
(* * test SIC)
(LIST -257 -256 -1 0 1 2 255 256 65535 65536 (QUOTE NIL])
(D2DTS.APPLY*0
[LAMBDA NIL (* jmh " 9-Dec-85 12:12")
(* * simple APPLY* case without stack-modelling complications)
(APPLY* (QUOTE LISTOFARGS)
1 2 3 4])
)
(* * dynamic tests)
(DEFINEQ
(D2DTS.N*
[NLAMBDA ARGS (* jmh " 9-Dec-85 09:53")
(* * nlambda*)
(CONS (LENGTH ARGS)
(REVERSE ARGS])
)
(DEFINEQ
(D2DTS.L*A
[LAMBDA NARGS (* jmh " 8-Dec-85 17:16")
(* * exercise constant-arg-nr lambda* args)
(if (IGEQ NARGS 11Q)
then (LET ((TEMP (ARG NARGS 11Q)))
(SETARG NARGS 11Q (ARG NARGS 10Q))
(SETARG NARGS 10Q (ARG NARGS 7))
(SETARG NARGS 7 TEMP)
(LIST (ARG NARGS 7)
(ARG NARGS 10Q)
(ARG NARGS 11Q])
(D2DTS.L*0
[LAMBDA NARGS (* jmh " 9-Dec-85 12:13")
(* * demonstrates compilation bug on SETARG)
(if (IGREATERP NARGS 7)
then (SETARG NARGS 8 (ARG NARGS 7))
(ARG NARGS 8])
(D2DTS.L*S
[LAMBDA NARGS (* jmh " 9-Dec-85 12:17")
(* * test lambda* ivar a specvar)
(DECLARE (SPECVARS . T))
(DONOTHING)
(CONS NARGS (if (IGREATERP NARGS 0)
then (ARG NARGS 1])
(D2DTS.L*C
[LAMBDA NARGS (* jmh " 9-Dec-85 09:52")
(* * exercise variable-arg-nr lambda* arg accesses)
(if (IGREATERP NARGS 1)
then (LET ((OLDARG1 (ARG NARGS 1)))
(for I from 2 to NARGS do (SETARG NARGS (SUB1 I)
(ARG NARGS I)))
(SETARG NARGS NARGS OLDARG1)))
(CONS NARGS (for I from 1 to NARGS collect (ARG NARGS I])
)
(DEFINEQ
(D2DTS.B0
[LAMBDA (SWITCH) (* jmh " 9-Dec-85 11:49")
(* * test BIND UNBIND DUNBIND -- run 3 times, with args 0 1 2)
(DECLARE (SPECVARS . T))
(LET* ((V 0)
(W (inc V))
(X (inc V))
(Y (inc V))
(Z (inc V)))
(LISTOFARGS (inc V)
[PROG ((W (inc V))
X
(Y (inc V)))
(RETURN (LISTOFARGS (inc V)
(if (OR (NOT (NUMBERP SWITCH))
(ZEROP SWITCH))
then (RETURN (LISTOFARGS Z Y X W))
elseif (EQ SWITCH 1)
then (RETURN)
else (inc V))
W X Y Z (inc V]
W X Y Z (inc V])
)
(DEFINEQ
(D2DTS.FNS
[LAMBDA NIL (* jmh " 9-Dec-85 12:03")
(* * test FN 7)
(LIST (LISTOFARGS)
(LISTOFARGS 1 2 3 4 5 6)
(LISTOFARGS 11 12 13 14 15 16 17)
(LISTOFARGS 21 22 23 24 25 26 27 28])
)
(* * utilities)
(DEFINEQ
(DONOTHING
[LAMBDA NIL NIL])
(LISTOFARGS
[LAMBDA NARGS
(* * return list of all args)
(for I from 1 to NARGS collect (ARG NARGS I])
)
(DECLARE: EVAL@COMPILE
(PUTPROPS inc MACRO ((X)
(add X 1)))
)
(* * test drivers)
(DEFINEQ
(COMPAREFN
[LAMBDA (FN ARGL) (* jmh " 8-Dec-85 16:26")
(LET ((OLDOUT (APPLY FN ARGL)))
(printout T OLDOUT T)
(DD FN)
(EQUAL OLDOUT (APPLY (QUOTE DASMFN)
ARGL])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA D2DTS.N*)
(ADDTOVAR NLAML D2DTS.N1LI D2DTS.N0)
(ADDTOVAR LAMA LISTOFARGS D2DTS.L*C D2DTS.L*S D2DTS.L*0 D2DTS.L*A)
)
(PUTPROPS D2DTESTSUITE COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1211 3559 (D2DTS.L0 1221 . 1430) (D2DTS.L1LI 1432 . 1701) (D2DTS.L2LI 1703 . 1952) (
D2DTS.L3LI 1954 . 2206) (D2DTS.L4LI 2208 . 2463) (D2DTS.L5LI 2465 . 2723) (D2DTS.L6LI 2725 . 2998) (
D2DTS.L7LI 3000 . 3276) (D2DTS.L8LI 3278 . 3557)) (3560 5416 (D2DTS.L1SI 3570 . 3815) (D2DTS.L3SI 3817
. 4068) (D2DTS.L4SI 4070 . 4324) (D2DTS.L5SI 4326 . 4583) (D2DTS.L6SI 4585 . 4857) (D2DTS.L7SI 4859
. 5134) (D2DTS.L8SI 5136 . 5414)) (5417 5841 (D2DTS.N0 5427 . 5590) (D2DTS.N1LI 5592 . 5839)) (5842
6276 (D2DTS.IPFLS 5852 . 6274)) (6277 6947 (D2DTS.APPLY 6287 . 6489) (D2DTS.SIC 6491 . 6698) (
D2DTS.APPLY*0 6700 . 6945)) (6974 7179 (D2DTS.N* 6984 . 7177)) (7180 8727 (D2DTS.L*A 7190 . 7650) (
D2DTS.L*0 7652 . 7931) (D2DTS.L*S 7933 . 8234) (D2DTS.L*C 8236 . 8725)) (8728 9464 (D2DTS.B0 8738 .
9462)) (9465 9770 (D2DTS.FNS 9475 . 9768)) (9793 9989 (DONOTHING 9803 . 9837) (LISTOFARGS 9839 . 9987)
) (10082 10361 (COMPAREFN 10092 . 10359)))))
STOP