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

[astalla at common-lisp.net]

Author: astalla
Date: Thu Jan 19 17:10:39 2012
New Revision: 13792

Log:
A small reorganization of compiler/jvm code. Runtime-class wasn't autoloading properly in certain situations due to a wrong dependency graph among some system files.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
   trunk/abcl/src/org/armedbear/lisp/jvm-instructions.lisp
   trunk/abcl/src/org/armedbear/lisp/jvm.lisp
   trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp
   trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Tue Jan 17 14:44:37 2012	(r13791)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Thu Jan 19 17:10:39 2012	(r13792)
@@ -42,6 +42,7 @@
   (require "KNOWN-SYMBOLS")
   (require "DUMP-FORM")
   (require "JVM-INSTRUCTIONS")
+  (require "JVM-CLASS-FILE")
   (require "JAVA"))
 
 

Modified: trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	Tue Jan 17 14:44:37 2012	(r13791)
+++ trunk/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	Thu Jan 19 17:10:39 2012	(r13792)
@@ -30,6 +30,7 @@
 ;;; exception statement from your version.
 
 (in-package "JVM")
+(require '#:compiler-types)
 
 #|
 
@@ -1511,3 +1512,4 @@
 
 |#
 
+(provide '#:jvm-class-file)
\ No newline at end of file

Modified: trunk/abcl/src/org/armedbear/lisp/jvm-instructions.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm-instructions.lisp	Tue Jan 17 14:44:37 2012	(r13791)
+++ trunk/abcl/src/org/armedbear/lisp/jvm-instructions.lisp	Thu Jan 19 17:10:39 2012	(r13792)
@@ -32,6 +32,36 @@
 
 (in-package #:jvm)
 
+(declaim (inline u2 s1 s2))
+
+(defknown u2 (fixnum) cons)
+(defun u2 (n)
+  (declare (optimize speed))
+  (declare (type (unsigned-byte 16) n))
+  (when (not (<= 0 n 65535))
+    (error "u2 argument ~A out of 65k range." n))
+  (list (logand (ash n -8) #xff)
+        (logand n #xff)))
+
+(defknown s1 (fixnum) fixnum)
+(defun s1 (n)
+  (declare (optimize speed))
+  (declare (type (signed-byte 8) n))
+  (when (not (<= -128 n 127))
+    (error "s1 argument ~A out of 8-bit signed range." n))
+  (if (< n 0)
+      (1+ (logxor (- n) #xFF))
+      n))
+
+
+(defknown s2 (fixnum) cons)
+(defun s2 (n)
+  (declare (optimize speed))
+  (declare (type (signed-byte 16) n))
+  (when (not (<= -32768 n 32767))
+    (error "s2 argument ~A out of 16-bit signed range." n))
+  (u2 (if (< n 0) (1+ (logxor (- n) #xFFFF))
+          n)))
 
 ;;    OPCODES
 

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Tue Jan 17 14:44:37 2012	(r13791)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Thu Jan 19 17:10:39 2012	(r13792)
@@ -70,41 +70,6 @@
 (defmacro dformat (&rest ignored)
   (declare (ignore ignored)))
 
-(declaim (inline u2 s1 s2))
-
-(defknown u2 (fixnum) cons)
-(defun u2 (n)
-  (declare (optimize speed))
-  (declare (type (unsigned-byte 16) n))
-  (when (not (<= 0 n 65535))
-    (error "u2 argument ~A out of 65k range." n))
-  (list (logand (ash n -8) #xff)
-        (logand n #xff)))
-
-(defknown s1 (fixnum) fixnum)
-(defun s1 (n)
-  (declare (optimize speed))
-  (declare (type (signed-byte 8) n))
-  (when (not (<= -128 n 127))
-    (error "s1 argument ~A out of 8-bit signed range." n))
-  (if (< n 0)
-      (1+ (logxor (- n) #xFF))
-      n))
-
-
-(defknown s2 (fixnum) cons)
-(defun s2 (n)
-  (declare (optimize speed))
-  (declare (type (signed-byte 16) n))
-  (when (not (<= -32768 n 32767))
-    (error "s2 argument ~A out of 16-bit signed range." n))
-  (u2 (if (< n 0) (1+ (logxor (- n) #xFFFF))
-          n)))
-
-
-
-
-
 (defmacro with-saved-compiler-policy (&body body)
   "Saves compiler policy variables, restoring them after evaluating `body'."
   `(let ((*speed* *speed*)

Modified: trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp	Tue Jan 17 14:44:37 2012	(r13791)
+++ trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp	Thu Jan 19 17:10:39 2012	(r13792)
@@ -31,6 +31,7 @@
 
 (in-package #:system)
 
+(require "JVM-CLASS-FILE")
 (require "JAVA")
 
 (export '(lookup-known-symbol))

Modified: trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp	Tue Jan 17 14:44:37 2012	(r13791)
+++ trunk/abcl/src/org/armedbear/lisp/runtime-class.lisp	Thu Jan 19 17:10:39 2012	(r13792)
@@ -1,5 +1,4 @@
-(require "COMPILER-PASS2")
-(require "JVM-CLASS-FILE")
+(require "JVM")
 
 ;;The package is set to :jvm for convenience, since most of the symbols used
 ;;here come from that package. However, the functions we're definining belong
@@ -186,7 +185,7 @@
               (aload 0)
               (cond
                 ((jvm-class-name-p type) (aload 1))
-                ((eq type :int) (iload 1))
+                ((eq type :int) (emit 'iload 1))
                 (t (error "Unsupported setter parameter type: ~A" type)))
               (emit-putfield (class-file-class class-file) name type)
               (emit 'return))))))))
@@ -218,6 +217,7 @@
          (t (make-primitive-or-string-annotation-element :name name :value value)))))))
 
 ;;TODO:
+;; - Returning nil as null is broken
 ;; - Function calls with 8+ args
 ;; - super method invocation. Idea: generate companion methods super_... to use with plain jcall. Add a flag per method to optionally disable this when not needed.
 ;; - Constructors