~ chicken-core (chicken-5) 5441f5e1833793cd141f0e4b5a1e12428099b243


commit 5441f5e1833793cd141f0e4b5a1e12428099b243
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Oct 8 23:35:20 2010 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Oct 8 23:35:20 2010 +0200

    removed tinyclos support from csi's describe

diff --git a/csi.scm b/csi.scm
index c2d40c1b..3cf2f271 100644
--- a/csi.scm
+++ b/csi.scm
@@ -609,13 +609,9 @@ EOF
 	    [(pair? x) (fprintf out "pair with car ~S~%and cdr ~S~%" (car x) (cdr x))]
 	    [(procedure? x)
 	     (let ([len (##sys#size x)])
-	       (if (and (> len 3)
-			(memq #:tinyclos ##sys#features)
-			(eq? ##tinyclos#entity-tag (##sys#slot x (fx- len 1))) ) ;XXX handle this in tinyclos egg (difficult)
-		   (describe-object x out)
-		   (descseq 
-		    (sprintf "procedure with code pointer ~X" (##sys#peek-unsigned-integer x 0))
-		    ##sys#size ##sys#slot 1) ) ) ]
+	       (descseq 
+		(sprintf "procedure with code pointer ~X" (##sys#peek-unsigned-integer x 0))
+		##sys#size ##sys#slot 1) ) ]
 	    [(port? x)
 	     (fprintf out
 		      "~A port of type ~A with name ~S and file pointer ~X~%"
@@ -623,8 +619,6 @@ EOF
 		      (##sys#slot x 7)
 		      (##sys#slot x 3)
 		      (##sys#peek-unsigned-integer x 0) ) ]
-	    [(and (memq #:tinyclos ##sys#features) (instance? x)) ; XXX put into tinyclos egg
-	     (describe-object x out) ]
 	    [(##sys#locative? x)
 	     (fprintf out "locative~%  pointer ~X~%  index ~A~%  type ~A~%"
 		      (##sys#peek-unsigned-integer x 0)
Trap