perm filename CTEST[CMP,SYS] blob sn#010426 filedate 1973-07-03 generic text, type T, neo UTF8
00100	~From here to the "END OF CTEST" message is the old file CTEST
00200	~The rest is the old file CBUGS
00300	
00400	(DEFPROP DFUNC
00500	         (LAMBDA (L) (LIST (Q DEFPROP) 
00600				   (CAADR L) 
00700				   (MCONS (Q LAMBDA) (CDADR L) (CDDR L)) 
00800				   (Q EXPR))) 
00900		 MACRO) 
01000	 
01100	(DEFPROP MCONS 
01200	 (LAMBDA (L) 
01300		 (COND ((NULL (CDDR L)) (CADR L)) 
01400		       (T (LIST (Q CONS) (CADR L) (CONS (CAR L) (CDDR L)))))) 
01500	 MACRO) 
01600	 
01700	(DEFPROP Q (LAMBDA (L) (CONS (QUOTE QUOTE) (CDR L))) MACRO) 
01800	 
01900	(DEFPROP EXPR0 (LAMBDA (LAS) T) EXPR)
02000	
02100	(DEFPROP EXPR1 (LAMBDA (X) X) EXPR)
02200	(DEFPROP FEXPR1 (LAMBDA (L) L) FEXPR)
02300	(DEFPROP LEXPR1 (LAMBDA N N) EXPR)
02400	
02500	(LAP SUBR1 SUBR) (POPJ P) NIL
02600	(LAP FSUBR1 FSUBR) (POPJ P) NIL
02700	(LAP LSUBR1 LSUBR) (JSP3 *LCALL) (POPJ P) NIL
02800	
02900	(DFUNC (EXPR2 X Y)
03000	       (PROG (A UPV)
03100		     (SETQ A X)
03200		     (SETQ UPV Y)
03300		MDT  (RETURN A)
03400		MDT  (GO UDT)
03500		     (PRINT FV)
03600		     (RETURN LAS)))
03700	
03800	(DE EXPR3 (Z) (MACRO1 (FEXPR2 Z) (LEXPR2 Z) (FSUBR2 Z) (LSUBR2 Z)))
03900	(DF FEXPR2 (L) L)
04000	(DE LEXPR2 L L)
04100	
04200	(LAP FSUBR2 FSUBR) (POPJ P) NIL
04300	(LAP LSUBR2 LSUBR) (JSP 3 *LCALL) (POPJ P) NIL
04400	
04500	
04600	(DEFPROP MACRO1 (LAMBDA (L) (CONS (Q LIST) (CDR L))) MACRO)
04700	
     

00100	(DE GENFUNS (X)
00200	 (PROG NIL
00300	       (MAPC (FUNCTION (LAMBDA (Y) (F Y Y))) X)
00400	       (MAPC (FUNCTION (LAMBDA (Y) (F Y Y))) X)
00500	       (MAPC (FUNCTION
00600		      (LAMBDA (Y)
00700		       (PROG2 (MAPC (FUNCTION (LAMBDA (Z) (F Z Z))) Y)
00800			      (MAPC (FUNCTION (LAMBDA (Z) (G Z Z))) Y))))
00900		     (MAPC (FUNCTION (LAMBDA (W)
01000				      (MAPC (FUNCTION (LAMBDA (X) (F (G X)))) W)))
01100			   X))))
01200	
     

00100	(DEFPROP VLBUG 
00200	 (LAMBDA NIL
00300		 (PROG (I) (AND (CAR (SETQ I (CAR I)))
00400				(SETQ I (CADR I))
00500				(EQ (CAR I) 4)))) 
00600	EXPR)
00700	
00800	(DEFPROP RLOSS1
00900	 (LAMBDA (OP) (PROG NIL (AND SP1 (CDR (RPLACD SP2 (COND (T OP))))))) 
01000	 EXPR)
01100	 
01200	 (DEFPROP RLOSS2
01300		  (LAMBDA NIL
01400		   (AND (FUN1)
01500			(PROG (PROGVAR) (COND ((FUN2) (RETURN PROGVAR))))))
01600	 	  EXPR)
01700	
01800	 (DEFPROP RTRICKY
01900		  (LAMBDA NIL
02000		   (PROG (A) (SETQ A 1) LOOP (FOO A (SETQ A 2) (BAR)))
02100	 	   EXPR)
02200	 	  EXPR)
02300	
     

00100	(DEFPROP T1 
00200	 (LAMBDA (X)
00300	  (MAPC (FUNCTION (LAMBDA (Y) (MAPC (FUNCTION (LAMBDA (Z) (F Z Z))) Y)))
00400		X)) 
00500	EXPR)
00600	(DFUNC (T2 X Y) (T3 X Y))
00700	
00800	(DEFPROP FOO BAR NLY)
00900	
01000	(PRINT (QUOTE (IT IS GONE)))
01100	
01200	(DEFPROP T3 
01300	 (LAMBDA (X)
01400		 (MAPCAR (FUNCTION (LAMBDA (Y)
01500					   (MAPCAR (FUNCTION (LAMBDA (Z) (F Z Z)))
01600						   Y)))
01700		 X)) 
01800	FEXPR)
01900	
02000	(LAP FOO SUBR)
02100		(POPJ P)
02200		NIL
02300	
02400	(DFUNC (T4) T)
02500	
02600	(LAP BAR FSUBR)
02700		(POPJ P)
02800		NIL
02900	
03000	(DEFPROP HENS LAY EGGS)
03100	
03200	(LAP BOBBY SUBR) (POPJ P) NIL 
03300	
03400	(QUOTE (MIDDLE OF FILE))
03500	
03600	(DEFPROP T5 
03700	 (LAMBDA X
03800	  (MAPCAR (FUNCTION (LAMBDA (Y) (MAPCAR (FUNCTION (LAMBDA (Z) (F Z Z)))
03900		  Y))) X)) 
04000	EXPR)
04100	
04200	(QUOTE (END OF CTEST))
04300	
     

00100	~If EQQ were `EQ' then BUG1 would give the same error as BUG3 and BUG4.
00110	~As it is, however, it give an `(X . 13) LOSTVAR-ILOC1' error.
00120	
00130	(DEFPROP BUG1
00140		 (LAMBDA (NAME)
00150			 (PROG (X)
00160			       (SETQ X
00170				     (APPEND
00180				      X
00190				      (PROG (&V)
00200				       LOOP (COND ((NOT (EQQ (SETQ X (READCH))
00210							     T))
00220						   (SETQ &V
00230							 (APPEND &V (LIST X))))
00240						  (T (RETURN &V)))
00250					    (GO LOOP))))))
00260		 EXPR)
00270	
00280	~If NACS is set to 3 then BUG2 results in a NOAC-RESTORE error.
00290	
00300	(DEFPROP BUG2
00310		 (LAMBDA NIL
00320			 (PROG (X)
00330			       (SETQ X
00340				     (CONS X
00350					   (PROG (&V)
00360					    LOOP (COND ((SETQ X T)
00370							(SETQ &V (LIST X)))
00380						       (T (RETURN &V)))
00390						 (GO LOOP))))))
00400		 EXPR)
00410	
00420	~BUG3 and BUG4 both produce extra pushes and pops.
00430	
00440	(DEFPROP BUG3 (LAMBDA NIL (PROG (X) (CONS X (COND ((SETQ X T) X))))) EXPR)
00450	
00460	(DEFPROP BUG4 (LAMBDA (X) (PROG NIL (CONS X (COND ((SETQ X T) X))))) EXPR)
00470	
     

00100	~This bug comes from Hearn.  It involves a variable being loaded as an 
00200	~argument by an EXCH, which leaves the only copy in the AC, then protected
00300	~by pushing which gives trouble.
00400	
00500	~CB1 is a simple case which produces a MOVE then a MOVEM.
00600	
00700	(DEFPROP CB1 (LAMBDA (A) (PROG (B) TAG (SETQ A A) (RETURN B))) EXPR)
00800	
00900	~CB2 generates the erronious EXCH then stops.
01000	
01100	(DEFPROP CB2
01200		 (LAMBDA (A) (PROG (B) TAG (SETQ B A) (SETQ A A) (RETURN B)))
01300		 EXPR)
01400	
01500	~CB3 continues from the error of CB2 into a disaster.
01600	
01700	(DEFPROP CB3
01800		 (LAMBDA (A)
01900			 (PROG (B)
02000			  TAG1 (SETQ B A)
02100			       (SETQ A A)
02200			       (COND ((FUN A B) (GO TAG3)))
02300			  TAG2 (RETURN B)
02400			  TAG3))
02500		 EXPR)
02600	
     

00100	
00200	~Daryl Lewis of U.C. Irvine contributed the folling bug.
00300	~The L is clobbered by the internal lambda to NIL.
00400	~This was fixed by modification of INTERNALLAMBDA on 24July72.
00500	
00600	(DE IRVBUG NIL (CONS L ((LAMBDA (L) NIL) NIL)))
00700	
00800	~This bug has been patched out of the compiler by keeping varlist empty.
00900	
01000	(DEFPROP VLBUG 
01100	 (LAMBDA NIL
01200		 (PROG (I) (AND (CAR (SETQ I (CAR I)))
01300				(SETQ I (CADR I))
01400				(EQ (CAR I) 4)))) 
01500	EXPR)
01600	
01700	~This appeared in the course of debugging a new compiler.  An element
01800	~of the CCLST is saved in the middle of the computation of a NOT.
01900	~This is because the CCLST is cleared by OUTJMP but not by P2BOOL.
02000	
02100	(DEFPROP T1 
02200		 (LAMBDA (X) (FUN (CAR X) (CONS (NOT X) X)))
02300		 EXPR)
02400	
     

00100	~This file was recovered from Summer 71 and expanded.
00200	~I believe that the bugs of RLOSS and CATEGORISE have been fixed.
00300	~HEARNBUG is the original form of CB1,2and3 in CBUGS.
00400	~VLBUG been patched by keeping VARLIST empty and the function has been
00500	~copied into CBUGS.
00600	
00700	(DEFPROP VLBUG 
00800	 (LAMBDA NIL
00900		 (PROG (I) (AND (CAR (SETQ I (CAR I)))
01000				(SETQ I (CADR I))
01100				(EQ (CAR I) 4)))) 
01200	EXPR)
01300	
01400	(DEFPROP RLOSS 
01500	 (LAMBDA (OP) (PROG NIL (AND SP1 (CDR (RPLACD SP2 (COND (T OP))))))) 
01600	EXPR)
01700	 
01800	(DEFPROP CATEGORISE
01900	 (LAMBDA NIL
02000	  (PROG (CATEG CATEGORY)
02100	        (PROG (&V)
02200	         LOOP (SETQ &V
02300	                    (AND (SETQ CATEG (QUOTE ""))
02400	                         (PROG (&V)
02500	                          LOOP (SETQ &V (SETQ CATEG (CAT CATEG (READCH))))
02600	                               (COND ((SETQ CATEGORY (COMPARE (AT CATEG) CATEGLIST)) (RETURN &V))
02700	                                     (T (GO LOOP)))))))))
02800	EXPR)
     

00100	~This bug comes from Hearn.  It involves a variable being loaded as an 
00200	~argument by an EXCH, which leaves the only copy in the AC, then protected
00300	~by pushing which gives trouble.
00400	
00500	(DEFPROP HEARNBUG
00600	 (LAMBDA (A B)
00700	  (PROG (C E I J K M N VAR)
00800		(COND ((OR (ATOM B) (ATOM A)) (RETURN 1)))
00900		(COND ((GEQ (CDAAR A) (CDAAR B)) (GO A0)))
01000		(SETQ I A)
01100		(SETQ A B)
01200		(SETQ B I)
01300	   A0	(SETQ VAR (CAAAR A))
01400		(SETQ M (CDAAR A))
01500		(SETQ N (CDAAR B))
01600		(SETQ A (REDLIST A))
01700		(SETQ B (REDLIST B))
01800	   A1	(SETQ E (GFINV (CAR B)))
01900	   A2	(SETQ C (GFTIMES (CAR A) E))
02000		(SETQ A (RPLACA A 0))
02100		(SETQ I (CDR A))
02200		(SETQ J (CDR B))
02300		(SETQ K 1)
02400	   G0142(COND ((GREATERP K N) (GO A4)))
02500		(RPLACA I (GFDIF (CAR I) (GFTIMES C (CAR J))))
02600		(SETQ I (CDR I))
02700		(SETQ J (CDR J))
02800		(SETQ K (PLUS K 1))
02900		(GO G0142)
03000	   A4	(COND ((NEQ (CAR A) 0) (GO A5)))
03100		(SETQ A (CDR A))
03200		(SETQ M (DIFFERENCE M 1))
03300		(COND ((GREATERP M 0) (GO A4)))
03400		(COND ((EQUAL (CAR A) 0) (GO A6)) (T (RETURN 1)))
03500	   A5	(COND ((GEQ M N) (GO A2)))
03600		(SETQ I A)
03700		(SETQ A B)
03800		(SETQ B I)
03900		(SETQ I N)
04000		(SETQ N M)
04100		(SETQ M I)
04200		(GO A1)
04300	   A6	(SETQ I B)
04400		(SETQ E (GFINV (CAR B)))
04500	   A7	(RPLACA I (GFTIMES E (CAR I)))
04600		(COND ((SETQ I (CDR I)) (GO A7)))
04700		(SETQ I B)
04800	   A8	(RPLACA I (CONS (CONS VAR N) (CAR I)))
04900	   A9	(COND ((EQUAL (SETQ N (DIFFERENCE N 1)) 0)
05000		       (RETURN (PROG2 (RPLACD I
05100					      (COND ((EQUAL (CADR I) 0) NIL)
05200						    (T (CADR I))))
05300				      B))))
05400		(SETQ I (CDR I))
05500		(COND ((EQUAL (CAR I) 0) (GO A9)) (T (GO A8)))))
05600	 EXPR)
     

00100	~This bug comes from John Allan.  It is a result of RSL getting
00200	~rebound in the non value boolean case.
00300	
00400	(DEFPROP JRABUG
00500	 (LAMBDA (X) (COND ((NULL X) (ONE)) ((MEMQ NIL X) (TWO)))) 
00600	EXPR)
00700	
00800	~This is a simple error in P2PROG2.  The case for test is screwed up.
00900	
01000	(DEFPROP BLFBUG
01100	 (LAMBDA NIL
01200	  (PROG (HOLDL SUFF SL)
01300	        (COND ((AND (PROG2 (SETQ SL (STRLEN SUFF))
01400				   (NOT (*LESS HOLDL (*PLUS SL 2))))))))) 
01500	 EXPR)
01600	
01700	~I found this bug in the process of debugging JRABUG and BLFBUG.
01800	~The last occurence of G is free but is not recognized as such.
01900	~This bug is classic dating all the way back to Blatt compilers.
02000	
02100	(DEFPROP NEXTSYM T *FSUBR)
02200	
02300	(DE WDBUG (XPR VALAC TEST)
02400	 (PROG NIL
02500	       (CLEARBOTH)
02600	       (COND ((NOT (NULL VALAC))
02700		      (RETURN (PROG (CTAG RSL G)
02800				    (PUTPROP (SETQ G (NEXTSYM TAG)) T (QUOTE SET))
02900				    (BOOLEXPR XPR VALAC (CONS T G))
03000				    (RETURN (TESTJUMP (BOOLVALUE VALAC G)
03100						      TEST))))))
03200	       (BOOLEXPR XPR VALAC TEST)
03300	       (COND ((NULL TEST) (OUTENDTAG G)))))
03400