[armedbear-cvs] r11490 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Sat Dec 27 14:59:26 2008
New Revision: 11490

Log:
Implement CDR6: *inspector-hook*.

This implements feature request ticket #9.

Modified:
   trunk/abcl/src/org/armedbear/lisp/Keyword.java
   trunk/abcl/src/org/armedbear/lisp/Lisp.java
   trunk/abcl/src/org/armedbear/lisp/Symbol.java
   trunk/abcl/src/org/armedbear/lisp/inspect.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/Keyword.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Keyword.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Keyword.java	Sat Dec 27 14:59:26 2008
@@ -144,5 +144,6 @@
         WILD_INFERIORS      = internKeyword("WILD-INFERIORS"),
         WINDOWS             = internKeyword("WINDOWS"),
         X86                 = internKeyword("X86"),
-        X86_64              = internKeyword("X86-64");
+        X86_64              = internKeyword("X86-64"),
+        CDR6                = internKeyword("CDR6");
 }

Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Lisp.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Lisp.java	Sat Dec 27 14:59:26 2008
@@ -2120,54 +2120,60 @@
     String osName = System.getProperty("os.name");
     if (osName.startsWith("Linux"))
       {
-        Symbol.FEATURES.setSymbolValue(list6(Keyword.ARMEDBEAR,
+        Symbol.FEATURES.setSymbolValue(list7(Keyword.ARMEDBEAR,
                                              Keyword.ABCL,
                                              Keyword.COMMON_LISP,
                                              Keyword.ANSI_CL,
                                              Keyword.UNIX,
-                                             Keyword.LINUX));
+                                             Keyword.LINUX,
+                                             Keyword.CDR6));
       }
     else if (osName.startsWith("SunOS"))
       {
-        Symbol.FEATURES.setSymbolValue(list6(Keyword.ARMEDBEAR,
+        Symbol.FEATURES.setSymbolValue(list7(Keyword.ARMEDBEAR,
                                              Keyword.ABCL,
                                              Keyword.COMMON_LISP,
                                              Keyword.ANSI_CL,
                                              Keyword.UNIX,
-                                             Keyword.SUNOS));
+                                             Keyword.SUNOS,
+                                             Keyword.CDR6));
       }
     else if (osName.startsWith("Mac OS X"))
       {
-        Symbol.FEATURES.setSymbolValue(list6(Keyword.ARMEDBEAR,
+        Symbol.FEATURES.setSymbolValue(list7(Keyword.ARMEDBEAR,
                                              Keyword.ABCL,
                                              Keyword.COMMON_LISP,
                                              Keyword.ANSI_CL,
                                              Keyword.UNIX,
-                                             Keyword.DARWIN));
+                                             Keyword.DARWIN,
+                                             Keyword.CDR6));
       }
     else if (osName.startsWith("FreeBSD"))
       {
-        Symbol.FEATURES.setSymbolValue(list6(Keyword.ARMEDBEAR,
+        Symbol.FEATURES.setSymbolValue(list7(Keyword.ARMEDBEAR,
                                              Keyword.ABCL,
                                              Keyword.COMMON_LISP,
                                              Keyword.ANSI_CL,
                                              Keyword.UNIX,
-                                             Keyword.FREEBSD));
+                                             Keyword.FREEBSD,
+                                             Keyword.CDR6));
       }
     else if (osName.startsWith("Windows"))
       {
-        Symbol.FEATURES.setSymbolValue(list5(Keyword.ARMEDBEAR,
+        Symbol.FEATURES.setSymbolValue(list6(Keyword.ARMEDBEAR,
                                              Keyword.ABCL,
                                              Keyword.COMMON_LISP,
                                              Keyword.ANSI_CL,
-                                             Keyword.WINDOWS));
+                                             Keyword.WINDOWS,
+                                             Keyword.CDR6));
       }
     else
       {
-        Symbol.FEATURES.setSymbolValue(list4(Keyword.ARMEDBEAR,
+        Symbol.FEATURES.setSymbolValue(list5(Keyword.ARMEDBEAR,
                                              Keyword.ABCL,
                                              Keyword.COMMON_LISP,
-                                             Keyword.ANSI_CL));
+                                             Keyword.ANSI_CL,
+                                             Keyword.CDR6));
       }
   }
   static
@@ -2522,6 +2528,12 @@
   protected static boolean TRAP_OVERFLOW  = true;
   protected static boolean TRAP_UNDERFLOW = true;
 
+
+  // Extentions
+  static {
+    Symbol._INSPECTOR_HOOK_.initializeSpecial(NIL);
+  }
+
   private static final void loadClass(String className)
   {
     try

Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java	Sat Dec 27 14:59:26 2008
@@ -3010,4 +3010,9 @@
     PACKAGE_SYS.addInternalSymbol("STRING-INPUT-STREAM");
   public static final Symbol STRING_OUTPUT_STREAM =
     PACKAGE_SYS.addInternalSymbol("STRING-OUTPUT-STREAM");
+
+  // CDR6
+  public static final Symbol _INSPECTOR_HOOK_ =
+    PACKAGE_EXT.addExternalSymbol("*INSPECTOR-HOOK*");
+
 }

Modified: trunk/abcl/src/org/armedbear/lisp/inspect.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/inspect.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/inspect.lisp	Sat Dec 27 14:59:26 2008
@@ -139,6 +139,8 @@
       (format t "No object is being inspected.")))
 
 (defun inspect (obj)
+  (unless ext:*inspector-hook*
+    (funcall ext:*inspector-hook* obj))
   (when *inspected-object*
     (push *inspected-object* *inspected-object-stack*))
   (setf *inspected-object* obj)