Changeset 11926

Timestamp:

05/22/09 18:04:53 (14 years ago)

Author:

ehuelsmann

Message:

Compilation of functions with a non-null
lexical environment part 2 [of 2]: Functions.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• Environment.java (modified) (1 diff)
• Primitives.java (modified) (1 diff)
• compiler-pass2.lisp (modified) (4 diffs)
• jvm.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/Environment.java

@@ -348 +348 @@
       }
     };
+
+  // ### environment-all-functions
+  private static final Primitive ENVIRONMENT_ALL_FUNS =
+    new Primitive("environment-all-functions", PACKAGE_SYS, true, "environment")
+    {
+      @Override
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+            Environment env = checkEnvironment(arg);
+            LispObject result = NIL;
+            for (FunctionBinding binding = env.lastFunctionBinding;
+                 binding != null; binding = binding.next)
+            result = result.push(new Cons(binding.name, binding.value));
+            return result.nreverse();
+      }
+    };
 }

trunk/abcl/src/org/armedbear/lisp/Primitives.java

@@ -1787 +1787 @@
       }
     };
+
+  // ### macro-function-p
+  private static final Primitive MACRO_FUNCTION_P =
+      new Primitive("macro-function-p", PACKAGE_SYS, true, "value")
+  {
+      @Override
+      public LispObject execute(LispObject arg) throws ConditionThrowable
+      {
+          return (arg instanceof MacroObject) ? T : NIL;
+      }
+  };
+
 
   // ### make-symbol-macro

trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -3029 +3029 @@
                              (local-function-variable local-function))
                             'stack nil))
+          ((local-function-environment local-function)
+           (assert (local-function-references-allowed-p local-function))
+           (assert (not *file-compilation*))
+           (emit 'getstatic *this-class*
+                 (declare-object (local-function-environment local-function)
+                                 +lisp-environment+
+                                 +lisp-environment-class+)
+                 +lisp-environment+)
+           (emit 'getstatic *this-class*
+                 (declare-object (local-function-name local-function))
+                 +lisp-object+)
+           (emit-invokevirtual +lisp-environment-class+ "lookupFunction"
+                               (list +lisp-object+)
+                               +lisp-object+))
           (t
            (dformat t "compile-local-function-call default case~%")
@@ -8241 +8255 @@
         (*closure-variables* nil)
         (*undefined-variables* nil)
-        (*local-functions* nil)
+        (*local-functions* *local-functions*)
         (*current-compiland* compiland))
     (with-saved-compiler-policy
@@ -8418 +8432 @@
         (*file-compilation* nil)
         (*visible-variables* nil)
+        (*local-functions* nil)
         (*pathnames-generator* #'make-temp-file)
         (sys::*fasl-anonymous-package* (sys::%make-package))
@@ -8442 +8457 @@
                              (not (sys:symbol-macro-p (cdr var)))
                              :compiland NIL) *visible-variables*)))
+    (when environment
+      (dolist (fun (reverse (environment-all-functions environment)))
+        (push (make-local-function :name (car fun)
+                                   :references-allowed-p
+                                   (not (macro-function-p (cdr fun)))
+                                   :environment environment)
+              *local-functions*)))
     ;; FIXME: we still need to add local functions, ofcourse.
     (handler-bind

trunk/abcl/src/org/armedbear/lisp/jvm.lisp

@@ -338 +338 @@
   compiland
   inline-expansion
-  function  ;; the function loaded through load-compiled-function
-  class-file
-  variable  ;; the variable which contains the loaded compiled function
-            ;; or compiled closure
+  function    ;; the function loaded through load-compiled-function
+  class-file  ;; the class file structure for this function
+  variable    ;; the variable which contains the loaded compiled function
+              ;; or compiled closure
+  environment ;; the environment in which the function is stored in
+              ;; case of a function from an enclosing lexical environment
+              ;; which itself isn't being compiled
+  (references-allowed-p t)
   )