[armedbear-cvs] r12638 - branches/less-reflection/abcl/src/org/armedbear/lisp

[Alessio Stalla]

Author: astalla
Date: Wed Apr 28 17:04:28 2010
New Revision: 12638

Log:
Experimental: special operator to insert inline bytecode in compiled Lisp functions.


Modified:
   branches/less-reflection/abcl/src/org/armedbear/lisp/Lisp.java
   branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
   branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   branches/less-reflection/abcl/src/org/armedbear/lisp/precompiler.lisp

Modified: branches/less-reflection/abcl/src/org/armedbear/lisp/Lisp.java
==============================================================================
--- branches/less-reflection/abcl/src/org/armedbear/lisp/Lisp.java	(original)
+++ branches/less-reflection/abcl/src/org/armedbear/lisp/Lisp.java	Wed Apr 28 17:04:28 2010
@@ -2739,4 +2739,16 @@
     Symbol.DEBUG_IO.initializeSpecial(new TwoWayStream(stdin, stdout, true));
   }
 
+  private static final SpecialOperator WITH_INLINE_CODE = new with_inline_code();
+  private static class with_inline_code extends SpecialOperator {
+    with_inline_code() {
+      super("with-inline-code", PACKAGE_JVM, true, "(&optional target repr) &body body");
+    }
+    @Override
+    public LispObject execute(LispObject args, Environment env)
+    {
+	return error(new SimpleError("This is a placeholder. It should only be called in compiled code, and tranformed by the compiler using special form handlers."));
+    }
+  }
+
 }

Modified: branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	(original)
+++ branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Wed Apr 28 17:04:28 2010
@@ -1432,7 +1432,8 @@
                   (TRULY-THE            p1-truly-the)
                   (UNWIND-PROTECT       p1-unwind-protect)
                   (THREADS:SYNCHRONIZED-ON
-                                        p1-threads-synchronized-on)))
+                                        p1-threads-synchronized-on)
+		  (JVM::WITH-INLINE-CODE identity)))
     (install-p1-handler (%car pair) (%cadr pair))))
 
 (initialize-p1-handlers)

Modified: branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ branches/less-reflection/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Wed Apr 28 17:04:28 2010
@@ -2179,7 +2179,7 @@
 	  (class-name (concatenate 'string "org/armedbear/lisp/" (pathname-name pathname)))
 	  (*code* *static-code*))
      ;; fixme *declare-inline*
-     (declare-field g +lisp-object+ +field-access-default+)
+     (declare-field g +lisp-object+ +field-access-private+)
      (emit 'new class-name)
      (emit 'dup)
      (emit-invokespecial-init class-name '())
@@ -8608,6 +8608,13 @@
     (push execute-method (abcl-class-file-methods class-file)))
   t)
 
+(defun p2-with-inline-code (form target representation)
+  ;;form = (with-inline-code (&optional target-var repr-var) ...body...)
+  (destructuring-bind (&optional target-var repr-var) (cadr form)
+    (eval `(let (,@(when target-var `((,target-var ,target)))
+		 ,@(when repr-var `((,repr-var ,representation))))
+	     ,@(cddr form)))))
+
 (defun compile-1 (compiland stream)
   (let ((*all-variables* nil)
         (*closure-variables* nil)
@@ -8986,6 +8993,7 @@
   (install-p2-handler 'vector-push-extend  'p2-vector-push-extend)
   (install-p2-handler 'write-8-bits        'p2-write-8-bits)
   (install-p2-handler 'zerop               'p2-zerop)
+  (install-p2-handler 'with-inline-code    'p2-with-inline-code)
   t)
 
 (initialize-p2-handlers)

Modified: branches/less-reflection/abcl/src/org/armedbear/lisp/precompiler.lisp
==============================================================================
--- branches/less-reflection/abcl/src/org/armedbear/lisp/precompiler.lisp	(original)
+++ branches/less-reflection/abcl/src/org/armedbear/lisp/precompiler.lisp	Wed Apr 28 17:04:28 2010
@@ -1021,7 +1021,9 @@
                   (TRULY-THE            precompile-truly-the)
 
                   (THREADS:SYNCHRONIZED-ON
-                                        precompile-threads-synchronized-on)))
+                                        precompile-threads-synchronized-on)
+		  
+		  (JVM::WITH-INLINE-CODE precompile-identity)))
     (install-handler (first pair) (second pair))))
 
 (install-handlers)