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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sat Aug 18 01:19:56 2012
New Revision: 14113

Log:
Merge StandardObjectFunctions into StandardObject: the former defines
a single Primitive while  the latter defines multiple.

Also, add all the defined primitives to the java-autoloader.

Deleted:
   trunk/abcl/src/org/armedbear/lisp/StandardObjectFunctions.java
Modified:
   trunk/abcl/src/org/armedbear/lisp/Autoload.java
   trunk/abcl/src/org/armedbear/lisp/StandardObject.java

Modified: trunk/abcl/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Autoload.java	Sat Aug 18 01:17:42 2012	(r14112)
+++ trunk/abcl/src/org/armedbear/lisp/Autoload.java	Sat Aug 18 01:19:56 2012	(r14113)
@@ -564,6 +564,8 @@
         autoload(PACKAGE_SYS, "%run-shell-command", "ShellCommand");
         autoload(PACKAGE_SYS, "%server-socket-close", "server_socket_close");
         autoload(PACKAGE_SYS, "%set-arglist", "arglist");
+        autoload(PACKAGE_CL, "find-class", "LispClass", true);
+        autoload(PACKAGE_SYS, "%set-find-class", "LispClass", true);
         autoload(PACKAGE_SYS, "%set-class-direct-slots", "SlotClass", true);
         autoload(PACKAGE_SYS, "%set-function-info", "function_info");
         autoload(PACKAGE_SYS, "%set-generic-function-lambda-list", "StandardGenericFunction", true);
@@ -618,7 +620,7 @@
         autoload(PACKAGE_SYS, "cache-slot-location", "StandardGenericFunction", true);
         autoload(PACKAGE_SYS, "canonicalize-logical-host", "LogicalPathname", true);
         autoload(PACKAGE_SYS, "class-direct-slots", "SlotClass");
-	autoload(PACKAGE_SYS, "%float-bits", "FloatFunctions");
+        autoload(PACKAGE_SYS, "%float-bits", "FloatFunctions");
         autoload(PACKAGE_SYS, "coerce-to-double-float", "FloatFunctions");
         autoload(PACKAGE_SYS, "coerce-to-single-float", "FloatFunctions");
         autoload(PACKAGE_SYS, "compute-class-direct-slots", "SlotClass", true);
@@ -683,7 +685,16 @@
         autoload(PACKAGE_SYS, "set-slot-definition-writers", "SlotDefinition", true);
         autoload(PACKAGE_SYS, "simple-list-remove-duplicates", "simple_list_remove_duplicates");
         autoload(PACKAGE_SYS, "single-float-bits", "FloatFunctions", true);
-        autoload(PACKAGE_SYS, "%std-allocate-instance", "StandardObjectFunctions", true);
+        autoload(PACKAGE_SYS, "%std-allocate-instance", "StandardObject", true);
+        autoload(PACKAGE_SYS, "swap-slots", "StandardObject", true);
+        autoload(PACKAGE_SYS, "std-instance-layout", "StandardObject", true);
+        autoload(PACKAGE_SYS, "%set-std-instance-layout", "StandardObject", true);
+        autoload(PACKAGE_SYS, "std-instance-class", "StandardObject", true);
+        autoload(PACKAGE_SYS, "standard-instance-access", "StandardObject", true);
+        autoload(PACKAGE_SYS, "%set-standard-instance-access", "StandardObject", true);
+        autoload(PACKAGE_SYS, "std-slot-boundp", "StandardObject", true);
+        autoload(PACKAGE_SYS, "std-slot-value", "StandardObject", true);
+        autoload(PACKAGE_SYS, "set-std-slot-value", "StandardObject", true);
         autoload(PACKAGE_SYS, "%allocate-funcallable-instance", "FuncallableStandardObject", true);
         autoload(PACKAGE_SYS, "unzip", "unzip", true);
         autoload(PACKAGE_SYS, "zip", "zip", true);

Modified: trunk/abcl/src/org/armedbear/lisp/StandardObject.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/StandardObject.java	Sat Aug 18 01:17:42 2012	(r14112)
+++ trunk/abcl/src/org/armedbear/lisp/StandardObject.java	Sat Aug 18 01:19:56 2012	(r14113)
@@ -615,4 +615,33 @@
       return third;
     }
   };
+
+  private static final Primitive _STD_ALLOCATE_INSTANCE 
+    = new pf__std_allocate_instance();
+  @DocString(name="%std-allocate-instance",
+             args="class",
+             returns="instance")
+  private static final class pf__std_allocate_instance extends Primitive
+  {
+    pf__std_allocate_instance()
+    {
+      super("%std-allocate-instance", PACKAGE_SYS, true, "class");
+    }
+    @Override
+    public LispObject execute(LispObject arg)
+    {
+      if (arg == StandardClass.STANDARD_CLASS)
+        return new StandardClass();
+      if (arg instanceof StandardClass)
+        return ((StandardClass)arg).allocateInstance();
+      if (arg.typep(StandardClass.STANDARD_CLASS) != NIL) {
+        LispObject l = Symbol.CLASS_LAYOUT.execute(arg);
+        if (! (l instanceof Layout))
+          return error(new ProgramError("Invalid standard class layout for: " + arg.princToString()));
+        
+        return new StandardObject((Layout)l);
+      }
+      return type_error(arg, Symbol.STANDARD_CLASS);
+    }
+  };
 }