Changeset 12918

Timestamp:

09/24/10 22:35:02 (13 years ago)

Author:

astalla

Message:

generic-class-file branch merged.

Location:

trunk/abcl

Files:

• abcl.asd (modified) (1 diff)
• src/org/armedbear/lisp/compile-file.lisp (modified) (2 diffs)
• src/org/armedbear/lisp/compile-system.lisp (modified) (1 diff)
• src/org/armedbear/lisp/compiler-pass2.lisp (modified) (231 diffs)
• src/org/armedbear/lisp/jvm-class-file.lisp (copied) (copied from branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp)
• src/org/armedbear/lisp/jvm-instructions.lisp (copied) (copied from branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-instructions.lisp)
• src/org/armedbear/lisp/jvm.lisp (modified) (7 diffs)
• src/org/armedbear/lisp/known-symbols.lisp (modified) (1 diff)
• src/org/armedbear/lisp/opcodes.lisp (deleted)
• test/lisp/abcl/class-file.lisp (copied) (copied from branches/generic-class-file/abcl/test/lisp/abcl/class-file.lisp)
• test/lisp/ansi/parse-ansi-errors.lisp (modified) (1 diff)

trunk/abcl/abcl.asd

@@ -33 +33 @@
                      ((:file "compiler-tests")
                       (:file "condition-tests")
+                      (:file "class-file")
                       (:file "metaclass")
                       #+abcl

trunk/abcl/src/org/armedbear/lisp/compile-file.lisp

@@ -673 +673 @@
   `(case ,expr ,@clauses))))
 
+(defconstant +fasl-classloader+
+  (jvm::make-class-name "org.armedbear.lisp.FaslClassLoader"))
+
 (defun generate-loader-function ()
   (let* ((basename (base-classname))
@@ -681 +684 @@
        :for i :from 1 :to *class-number*
        :collect
-       (let ((class (%format nil "org/armedbear/lisp/~A_~A" basename i)))
+       (let* ((class (%format nil "org/armedbear/lisp/~A_~A"
+                                                basename i))
+                                (class-name (jvm::make-class-name class)))
          `(,(1- i)
             (jvm::with-inline-code ()
         (jvm::emit 'jvm::aload 1)
-        (jvm::emit-invokevirtual jvm::+lisp-object-class+ "javaInstance"
+        (jvm::emit-invokevirtual jvm::+lisp-object+ "javaInstance"
                nil jvm::+java-object+)
-        (jvm::emit 'jvm::checkcast "org/armedbear/lisp/FaslClassLoader")
+        (jvm::emit-checkcast +fasl-classloader+)
         (jvm::emit 'jvm::dup)
         (jvm::emit-push-constant-int ,(1- i))
-        (jvm::emit 'jvm::new ,class)
+        (jvm::emit-new ,class-name)
         (jvm::emit 'jvm::dup)
-        (jvm::emit-invokespecial-init ,class '())
-        (jvm::emit-invokevirtual "org/armedbear/lisp/FaslClassLoader" "putFunction"
-               (list "I" jvm::+lisp-object+) jvm::+lisp-object+)
+        (jvm::emit-invokespecial-init ,class-name '())
+        (jvm::emit-invokevirtual +fasl-classloader+
+                                                         "putFunction"
+               (list :int jvm::+lisp-object+) jvm::+lisp-object+)
         (jvm::emit 'jvm::pop))
             t))))))

trunk/abcl/src/org/armedbear/lisp/compile-system.lisp

@@ -98 +98 @@
       (load (do-compile "compiler-pass1.lisp"))
       (load (do-compile "compiler-pass2.lisp"))
+      (load (do-compile "jvm-class-file.lisp"))
       (load (do-compile "jvm.lisp"))
       (load (do-compile "source-transform.lisp"))
       (load (do-compile "compiler-macro.lisp"))
-      (load (do-compile "opcodes.lisp"))
+      (load (do-compile "jvm-instructions.lisp"))
       (load (do-compile "setf.lisp"))
       (load (do-compile "extensible-sequences-base.lisp"))

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

@@ -42 +42 @@
   (require "KNOWN-SYMBOLS")
   (require "DUMP-FORM")
-  (require "OPCODES")
+  (require "JVM-INSTRUCTIONS")
   (require "JAVA"))
 
 
-(defun dump-pool ()
-  (let ((pool (reverse *pool*))
-        entry type)
-    (dotimes (index (1- *pool-count*))
-      (setq entry (car pool))
-      (setq type (case (car entry)
-                   (7 'class)
-                   (9 'field)
-                   (10 'method)
-                   (11 'interface)
-                   (8 'string)
-                   (3 'integer)
-                   (4 'float)
-                   (5 'long)
-                   (6 'double)
-                   (12 'name-and-type)
-                   (1 'utf8)))
-      (format t "~D: ~A ~S~%" (1+ index) type entry)
-      (setq pool (cdr pool))))
-  t)
-
-(defknown pool-get (t) (integer 1 65535))
-(defun pool-get (entry)
-  (declare (optimize speed (safety 0)))
-  (let* ((ht *pool-entries*)
-         (index (gethash1 entry ht)))
-    (declare (type hash-table ht))
-    (unless index
-      (setf index *pool-count*)
-      (push entry *pool*)
-      (setf (gethash entry ht) index)
-      (setf *pool-count* (1+ index)))
-    index))
-
-(declaim (ftype (function (string) fixnum) pool-name))
-(declaim (inline pool-name))
+(declaim (inline pool-name pool-string pool-name-and-type
+                 pool-class pool-field pool-method pool-int
+                 pool-float pool-long pool-double))
+
 (defun pool-name (name)
-  (declare (optimize speed))
-  (pool-get (list 1 (length name) name)))
-
-(declaim (ftype (function (string string) fixnum) pool-name-and-type))
-(declaim (inline pool-name-and-type))
+  (pool-add-utf8 *pool* name))
+
 (defun pool-name-and-type (name type)
-  (declare (optimize speed))
-  (pool-get (list 12
-                  (pool-name name)
-                  (pool-name type))))
-
-;; Assumes CLASS-NAME is already in the correct form ("org/armedbear/lisp/Lisp"
-;; as opposed to "org.armedbear.lisp.Lisp").
-(declaim (ftype (function (string) fixnum) pool-class))
-(declaim (inline pool-class))
-(defun pool-class (class-name)
-  (declare (optimize speed))
-  (pool-get (list 7 (pool-name class-name))))
-
-;; (tag class-index name-and-type-index)
-(declaim (ftype (function (string string string) fixnum) pool-field))
-(declaim (inline pool-field))
+  (pool-add-name/type *pool* name type))
+
+(defun pool-class (name)
+  (pool-add-class *pool* name))
+
+(defun pool-string (string)
+  (pool-add-string *pool* string))
+
 (defun pool-field (class-name field-name type-name)
-  (declare (optimize speed))
-  (pool-get (list 9
-                  (pool-class class-name)
-                  (pool-name-and-type field-name type-name))))
-
-;; (tag class-index name-and-type-index)
-(declaim (ftype (function (string string string) fixnum) pool-method))
-(declaim (inline pool-method))
+  (pool-add-field-ref *pool* class-name field-name type-name))
+
 (defun pool-method (class-name method-name type-name)
-  (declare (optimize speed))
-  (pool-get (list 10
-                  (pool-class class-name)
-                  (pool-name-and-type method-name type-name))))
-
-(declaim (ftype (function (string) fixnum) pool-string))
-(defun pool-string (string)
-  (declare (optimize speed))
-  (pool-get (list 8 (pool-name string))))
-
-(defknown pool-int (fixnum) (integer 1 65535))
-(defun pool-int (n)
-  (declare (optimize speed))
-  (pool-get (list 3 n)))
-
-(defknown pool-float (single-float) (integer 1 65535))
-(defun pool-float (n)
-  (declare (optimize speed))
-  (pool-get (list 4 (%float-bits n))))
-
-(defun pool-long/double (entry)
-  (let* ((ht *pool-entries*)
-         (index (gethash1 entry ht)))
-    (declare (type hash-table ht))
-    (unless index
-      (setf index *pool-count*)
-      (push entry *pool*)
-      (setf (gethash entry ht) index)
-      ;; The Java Virtual Machine Specification, Section 4.4.5: "All 8-byte
-      ;; constants take up two entries in the constant_pool table of the class
-      ;; file. If a CONSTANT_Long_info or CONSTANT_Double_info structure is the
-      ;; item in the constant_pool table at index n, then the next usable item in
-      ;; the pool is located at index n+2. The constant_pool index n+1 must be
-      ;; valid but is considered unusable." So:
-      (setf *pool-count* (+ index 2)))
-    index))
-
-(defknown pool-long (integer) (integer 1 65535))
-(defun pool-long (n)
-  (declare (optimize speed))
-  (declare (type java-long n))
-  (let* ((entry (list 5
-                      (logand (ash n -32) #xffffffff)
-                      (logand n #xffffffff))))
-    (pool-long/double entry)))
-
-(defknown pool-double (double-float) (integer 1 65535))
-(defun pool-double (n)
-  (declare (optimize speed))
-  (let* ((n (%float-bits n))
-         (entry (list 6
-                      (logand (ash n -32) #xffffffff)
-                      (logand n #xffffffff))))
-    (pool-long/double entry)))
-
-(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 "s2 argument ~A out of 16-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)))
-
-(defconstant +fasl-loader-class+
-  "org/armedbear/lisp/FaslClassLoader")
-(defconstant +java-string+ "Ljava/lang/String;")
-(defconstant +java-object+ "Ljava/lang/Object;")
-(defconstant +lisp-class+ "org/armedbear/lisp/Lisp")
-(defconstant +lisp-nil-class+ "org/armedbear/lisp/Nil")
-(defconstant +lisp-class-class+ "org/armedbear/lisp/LispClass")
-(defconstant +lisp-object-class+ "org/armedbear/lisp/LispObject")
-(defconstant +lisp-object+ "Lorg/armedbear/lisp/LispObject;")
-(defconstant +lisp-object-array+ "[Lorg/armedbear/lisp/LispObject;")
-(defconstant +closure-binding-array+ "[Lorg/armedbear/lisp/ClosureBinding;")
-(defconstant +closure-binding-class+ "org/armedbear/lisp/ClosureBinding")
-(defconstant +lisp-symbol-class+ "org/armedbear/lisp/Symbol")
-(defconstant +lisp-symbol+ "Lorg/armedbear/lisp/Symbol;")
-(defconstant +lisp-structure-object-class+ "org/armedbear/lisp/StructureObject")
-(defconstant +lisp-thread-class+ "org/armedbear/lisp/LispThread")
-(defconstant +lisp-thread+ "Lorg/armedbear/lisp/LispThread;")
-(defconstant +lisp-load-class+ "org/armedbear/lisp/Load")
-(defconstant +lisp-cons-class+ "org/armedbear/lisp/Cons")
-(defconstant +lisp-cons+ "Lorg/armedbear/lisp/Cons;")
-(defconstant +lisp-integer-class+ "org/armedbear/lisp/LispInteger")
-(defconstant +lisp-integer+ "Lorg/armedbear/lisp/LispInteger;")
-(defconstant +lisp-fixnum-class+ "org/armedbear/lisp/Fixnum")
-(defconstant +lisp-fixnum+ "Lorg/armedbear/lisp/Fixnum;")
-(defconstant +lisp-fixnum-array+ "[Lorg/armedbear/lisp/Fixnum;")
-(defconstant +lisp-function-proxy-class+
-  "org/armedbear/lisp/AutoloadedFunctionProxy")
-(defconstant +lisp-bignum-class+ "org/armedbear/lisp/Bignum")
-(defconstant +lisp-bignum+ "Lorg/armedbear/lisp/Bignum;")
-(defconstant +lisp-single-float-class+ "org/armedbear/lisp/SingleFloat")
-(defconstant +lisp-single-float+ "Lorg/armedbear/lisp/SingleFloat;")
-(defconstant +lisp-double-float-class+ "org/armedbear/lisp/DoubleFloat")
-(defconstant +lisp-double-float+ "Lorg/armedbear/lisp/DoubleFloat;")
-(defconstant +lisp-character-class+ "org/armedbear/lisp/LispCharacter")
-(defconstant +lisp-character+ "Lorg/armedbear/lisp/LispCharacter;")
-(defconstant +lisp-character-array+ "[Lorg/armedbear/lisp/LispCharacter;")
-(defconstant +lisp-abstract-bit-vector-class+ "org/armedbear/lisp/AbstractBitVector")
-(defconstant +lisp-abstract-vector-class+ "org/armedbear/lisp/AbstractVector")
-(defconstant +lisp-abstract-string-class+ "org/armedbear/lisp/AbstractString")
-(defconstant +lisp-abstract-string+ "Lorg/armedbear/lisp/AbstractString;")
-(defconstant +lisp-simple-vector-class+ "org/armedbear/lisp/SimpleVector")
-(defconstant +lisp-simple-string-class+ "org/armedbear/lisp/SimpleString")
-(defconstant +lisp-simple-string+ "Lorg/armedbear/lisp/SimpleString;")
-(defconstant +lisp-environment+ "Lorg/armedbear/lisp/Environment;")
-(defconstant +lisp-environment-class+ "org/armedbear/lisp/Environment")
-(defconstant +lisp-special-binding+ "Lorg/armedbear/lisp/SpecialBinding;")
-(defconstant +lisp-special-binding-class+ "org/armedbear/lisp/SpecialBinding")
-(defconstant +lisp-special-bindings-mark+ "Lorg/armedbear/lisp/SpecialBindingsMark;")
-(defconstant +lisp-special-bindings-mark-class+ "org/armedbear/lisp/SpecialBindingsMark")
-(defconstant +lisp-throw-class+ "org/armedbear/lisp/Throw")
-(defconstant +lisp-return-class+ "org/armedbear/lisp/Return")
-(defconstant +lisp-go-class+ "org/armedbear/lisp/Go")
-(defconstant +lisp-compiled-closure-class+ "org/armedbear/lisp/CompiledClosure")
-(defconstant +lisp-primitive-class+ "org/armedbear/lisp/Primitive")
-(defconstant +lisp-hash-table-class+ "org/armedbear/lisp/HashTable")
-(defconstant +lisp-eql-hash-table-class+ "org/armedbear/lisp/EqlHashTable")
-(defconstant +lisp-package-class+ "org/armedbear/lisp/Package")
-(defconstant +lisp-readtable-class+ "org/armedbear/lisp/Readtable")
-(defconstant +lisp-stream-class+ "org/armedbear/lisp/Stream")
-(defconstant +lisp-closure-class+ "org/armedbear/lisp/Closure")
-(defconstant +lisp-closure-parameter-class+ "org/armedbear/lisp/Closure$Parameter")
-(defconstant +lisp-closure-parameter-array+ "[Lorg/armedbear/lisp/Closure$Parameter;")
-
-(defstruct (instruction (:constructor %make-instruction (opcode args)))
-  (opcode 0 :type (integer 0 255))
-  args
-  stack
-  depth
-  wide)
-
-(defun make-instruction (opcode args)
-  (let ((inst (apply #'%make-instruction
-                     (list opcode
-                           (remove :wide-prefix args)))))
-    (when (memq :wide-prefix args)
-      (setf (inst-wide inst) t))
-    inst))
-
-(defun print-instruction (instruction)
-  (sys::%format nil "~A ~A stack = ~S depth = ~S"
-          (opcode-name (instruction-opcode instruction))
-          (instruction-args instruction)
-          (instruction-stack instruction)
-          (instruction-depth instruction)))
-
-(defknown inst * t)
-(defun inst (instr &optional args)
-  (declare (optimize speed))
-  (let ((opcode (if (fixnump instr)
-                    instr
-                    (opcode-number instr))))
-    (unless (listp args)
-      (setf args (list args)))
-    (make-instruction opcode args)))
-
-(defknown %%emit * t)
-(defun %%emit (instr &rest args)
-  (declare (optimize speed))
-  (let ((instruction (make-instruction instr args)))
-    (push instruction *code*)
-    instruction))
-
-(defknown %emit * t)
-(defun %emit (instr &rest args)
-  (declare (optimize speed))
-  (let ((instruction (inst instr args)))
-    (push instruction *code*)
-    instruction))
-
-(defmacro emit (instr &rest args)
-  (when (and (consp instr) (eq (car instr) 'QUOTE) (symbolp (cadr instr)))
-    (setf instr (opcode-number (cadr instr))))
-  (if (fixnump instr)
-      `(%%emit ,instr ,@args)
-      `(%emit ,instr ,@args)))
-
-(defknown label (symbol) t)
-(defun label (symbol)
-  (declare (type symbol symbol))
-  (declare (optimize speed))
-  (emit 'label symbol)
-  (setf (symbol-value symbol) nil))
-
-(defknown aload (fixnum) t)
-(defun aload (index)
-  (case index
-    (0 (emit 'aload_0))
-    (1 (emit 'aload_1))
-    (2 (emit 'aload_2))
-    (3 (emit 'aload_3))
-    (t (emit 'aload index))))
-
-(defknown astore (fixnum) t)
-(defun astore (index)
-  (case index
-    (0 (emit 'astore_0))
-    (1 (emit 'astore_1))
-    (2 (emit 'astore_2))
-    (3 (emit 'astore_3))
-    (t (emit 'astore index))))
+  (pool-add-method-ref *pool* class-name method-name type-name))
+
+(defun pool-int (int)
+  (pool-add-int *pool* int))
+
+(defun pool-float (float)
+  (pool-add-float *pool* float))
+
+(defun pool-long (long)
+  (pool-add-long *pool* long))
+
+(defun pool-double (double)
+  (pool-add-double *pool* double))
+
+(defun add-exception-handler (start end handler type)
+  (code-add-exception-handler *current-code-attribute*
+                              start end handler type))
+
+
 
 (defknown emit-push-nil () t)
 (declaim (inline emit-push-nil))
 (defun emit-push-nil ()
-  (emit-getstatic +lisp-class+ "NIL" +lisp-object+))
+  (emit-getstatic +lisp+ "NIL" +lisp-object+))
 
 (defknown emit-push-nil-symbol () t)
 (declaim (inline emit-push-nil-symbol))
 (defun emit-push-nil-symbol ()
-  (emit-getstatic +lisp-nil-class+ "NIL" +lisp-symbol+))
+  (emit-getstatic +lisp-nil+ "NIL" +lisp-symbol+))
 
 (defknown emit-push-t () t)
 (declaim (inline emit-push-t))
 (defun emit-push-t ()
-  (emit-getstatic +lisp-class+ "T" +lisp-symbol+))
+  (emit-getstatic +lisp+ "T" +lisp-symbol+))
 
 (defknown emit-push-false (t) t)
@@ -456 +202 @@
            (emit 'pop2)))))
 
-(declaim (ftype (function (t t) cons) make-descriptor-info))
-(defun make-descriptor-info (arg-types return-type)
-  (let ((descriptor (with-standard-io-syntax
-                      (with-output-to-string (s)
-                        (princ #\( s)
-                        (dolist (type arg-types)
-                          (princ type s))
-                        (princ #\) s)
-                        (princ (or return-type "V") s))))
-        (stack-effect (let ((result (cond ((null return-type) 0)
-                                          ((or (equal return-type "J")
-                                               (equal return-type "D")) 2)
-                                          (t 1))))
-                        (dolist (type arg-types result)
-                          (decf result (if (or (equal type "J")
-                                               (equal type "D"))
-                                           2 1))))))
-    (cons descriptor stack-effect)))
-
-(defparameter *descriptors* (make-hash-table :test #'equal))
-
-(declaim (ftype (function (t t) cons) get-descriptor-info))
-(defun get-descriptor-info (arg-types return-type)
-  (let* ((key (list arg-types return-type))
-         (ht *descriptors*)
-         (descriptor-info (gethash1 key ht)))
-    (declare (type hash-table ht))
-    (or descriptor-info
-        (setf (gethash key ht) (make-descriptor-info arg-types return-type)))))
-
-(declaim (inline get-descriptor))
-(defun get-descriptor (arg-types return-type)
-  (car (get-descriptor-info arg-types return-type)))
-
 (declaim (ftype (function * t) emit-invokestatic))
 (defun emit-invokestatic (class-name method-name arg-types return-type)
-  (let* ((info (get-descriptor-info arg-types return-type))
-         (descriptor (car info))
-         (stack-effect (cdr info))
-         (index (pool-method class-name method-name descriptor))
+  (let* ((stack-effect (apply #'descriptor-stack-effect return-type arg-types))
+         (index (pool-add-method-ref *pool* class-name
+                                     method-name (cons return-type arg-types)))
          (instruction (apply #'%emit 'invokestatic (u2 index))))
     (setf (instruction-stack instruction) stack-effect)))
@@ -503 +214 @@
 (declaim (ftype (function t string) pretty-java-class))
 (defun pretty-java-class (class)
-  (cond ((equal class +lisp-object-class+)
+  (cond ((equal class +lisp-object+)
          "LispObject")
         ((equal class +lisp-symbol+)
          "Symbol")
-        ((equal class +lisp-thread-class+)
+        ((equal class  +lisp-thread+)
          "LispThread")
         (t
@@ -514 +225 @@
 (defknown emit-invokevirtual (t t t t) t)
 (defun emit-invokevirtual (class-name method-name arg-types return-type)
-  (let* ((info (get-descriptor-info arg-types return-type))
-         (descriptor (car info))
-         (stack-effect (cdr info))
-         (index (pool-method class-name method-name descriptor))
+  (let* ((stack-effect (apply #'descriptor-stack-effect return-type arg-types))
+         (index (pool-add-method-ref *pool* class-name
+                                     method-name (cons return-type arg-types)))
          (instruction (apply #'%emit 'invokevirtual (u2 index))))
     (declare (type (signed-byte 8) stack-effect))
@@ -532 +242 @@
 (defknown emit-invokespecial-init (string list) t)
 (defun emit-invokespecial-init (class-name arg-types)
-  (let* ((info (get-descriptor-info arg-types nil))
-         (descriptor (car info))
-         (stack-effect (cdr info))
-         (index (pool-method class-name "<init>" descriptor))
+  (let* ((stack-effect (apply #'descriptor-stack-effect :void arg-types))
+         (index (pool-add-method-ref *pool* class-name
+                                     "<init>" (cons nil arg-types)))
          (instruction (apply #'%emit 'invokespecial (u2 index))))
     (declare (type (signed-byte 8) stack-effect))
@@ -557 +266 @@
                 ((equal type +lisp-thread+)
                  "LispThread")
-                ((equal type "C")
+                ((equal type :char)
                  "char")
-                ((equal type "I")
+                ((equal type :int)
                  "int")
-                ((equal type "Z")
+                ((equal type :boolean)
                  "boolean")
-                ((null type)
+                ((or (null type)
+                     (eq type :void))
                  "void")
                 (t
@@ -574 +284 @@
 (defknown emit-getstatic (t t t) t)
 (defun emit-getstatic (class-name field-name type)
-  (let ((index (pool-field class-name field-name type)))
+  (let ((index (pool-add-field-ref *pool* class-name field-name type)))
     (apply #'%emit 'getstatic (u2 index))))
 
 (defknown emit-putstatic (t t t) t)
 (defun emit-putstatic (class-name field-name type)
-  (let ((index (pool-field class-name field-name type)))
+  (let ((index (pool-add-field-ref *pool* class-name field-name type)))
     (apply #'%emit 'putstatic (u2 index))))
+
+(declaim (inline emit-getfield emit-putfield))
+(defknown emit-getfield (t t t) t)
+(defun emit-getfield (class-name field-name type)
+  (let* ((index (pool-add-field-ref *pool* class-name field-name type)))
+    (apply #'%emit 'getfield (u2 index))))
+
+(defknown emit-putfield (t t t) t)
+(defun emit-putfield (class-name field-name type)
+  (let* ((index (pool-add-field-ref *pool* class-name field-name type)))
+    (apply #'%emit 'putfield (u2 index))))
+
+
+(defknown emit-new (t) t)
+(declaim (inline emit-new emit-anewarray emit-checkcast emit-instanceof))
+(defun emit-new (class-name)
+  (apply #'%emit 'new (u2 (pool-class class-name))))
+
+(defknown emit-anewarray (t) t)
+(defun emit-anewarray (class-name)
+  (apply #'%emit 'anewarray (u2 (pool-class class-name))))
+
+(defknown emit-checkcast (t) t)
+(defun emit-checkcast (class-name)
+  (apply #'%emit 'checkcast (u2 (pool-class class-name))))
+
+(defknown emit-instanceof (t) t)
+(defun emit-instanceof (class-name)
+  (apply #'%emit 'instanceof (u2 (pool-class class-name))))
+
 
 (defvar type-representations '((:int fixnum)
@@ -614 +354 @@
 (defknown emit-unbox-boolean () t)
 (defun emit-unbox-boolean ()
-  (emit 'instanceof +lisp-nil-class+)
+  (emit-instanceof +lisp-nil+)
   (emit 'iconst_1)
   (emit 'ixor))  ;; 1 -> 0 && 0 -> 1: in other words, negate the low bit
@@ -621 +361 @@
 (defun emit-unbox-character ()
   (cond ((> *safety* 0)
-         (emit-invokestatic +lisp-character-class+ "getValue"
-                            (lisp-object-arg-types 1) "C"))
+         (emit-invokestatic +lisp-character+ "getValue"
+                            (lisp-object-arg-types 1) :char))
         (t
-         (emit 'checkcast +lisp-character-class+)
-         (emit 'getfield +lisp-character-class+ "value" "C"))))
+         (emit-checkcast +lisp-character+)
+         (emit-getfield +lisp-character+ "value" :char))))
 
 ;;                     source type /
@@ -643 +383 @@
 
 (defvar rep-classes
-  '((:boolean  #.+lisp-object-class+        #.+lisp-object+)
-    (:char     #.+lisp-character-class+     #.+lisp-character+)
-    (:int      #.+lisp-integer-class+       #.+lisp-integer+)
-    (:long     #.+lisp-integer-class+       #.+lisp-integer+)
-    (:float    #.+lisp-single-float-class+  #.+lisp-single-float+)
-    (:double   #.+lisp-double-float-class+  #.+lisp-double-float+))
+  `((:boolean . ,+lisp-object+)
+    (:char    . ,+lisp-character+)
+    (:int     . ,+lisp-integer+)
+    (:long    . ,+lisp-integer+)
+    (:float   . ,+lisp-single-float+)
+    (:double  . ,+lisp-double-float+))
   "Lists the class on which to call the `getInstance' method on,
 when converting the internal representation to a LispObject.")
 
-(defvar rep-arg-chars
-  '((:boolean . "Z")
-    (:char    . "C")
-    (:int     . "I")
-    (:long    . "J")
-    (:float   . "F")
-    (:double  . "D"))
-  "Lists the argument type identifiers for each
-of the internal representations.")
 
 (defun convert-representation (in out)
@@ -671 +402 @@
     ;; Convert back to a lisp object
     (when in
-      (let ((class (cdr (assoc in rep-classes)))
-            (arg-spec (cdr (assoc in rep-arg-chars))))
-        (emit-invokestatic (first class) "getInstance" (list arg-spec)
-                           (second class))))
+      (let ((class (cdr (assoc in rep-classes))))
+        (emit-invokestatic class "getInstance" (list in) class)))
     (return-from convert-representation))
   (let* ((in-map (cdr (assoc in rep-conversion)))
@@ -688 +417 @@
              (funcall op))
             ((stringp op)
-             (emit-invokevirtual +lisp-object-class+ op nil
-                                 (cdr (assoc out rep-arg-chars))))
+             (emit-invokevirtual +lisp-object+ op nil out))
             (t
              (emit op))))))
@@ -722 +450 @@
 (defun maybe-initialize-thread-var ()
   (when *initialize-thread-var*
-    (emit-invokestatic +lisp-thread-class+ "currentThread" nil +lisp-thread+)
+    (emit-invokestatic +lisp-thread+ "currentThread" nil +lisp-thread+)
     (astore *thread*)
     (setf *initialize-thread-var* nil)))
@@ -737 +465 @@
   (aload *thread*))
 
-(defun local-variable-p (variable)
+(defun variable-local-p (variable)
   "Return non-NIL if `variable' is a local variable.
 
@@ -746 +474 @@
 (defun emit-load-local-variable (variable)
   "Loads a local variable in the top stack position."
-  (aver (local-variable-p variable))
+  (aver (variable-local-p variable))
   (if (variable-register variable)
       (aload (variable-register variable))
@@ -764 +492 @@
 before the emitted code: the code is 'stack-neutral'."
   (declare (type symbol expected-type))
-  (unless (local-variable-p variable)
+  (unless (variable-local-p variable)
     (return-from generate-instanceof-type-check-for-variable))
   (let ((instanceof-class (ecase expected-type
-                            (SYMBOL     +lisp-symbol-class+)
-                            (CHARACTER  +lisp-character-class+)
-                            (CONS       +lisp-cons-class+)
-                            (HASH-TABLE +lisp-hash-table-class+)
-                            (FIXNUM     +lisp-fixnum-class+)
-                            (STREAM     +lisp-stream-class+)
-                            (STRING     +lisp-abstract-string-class+)
-                            (VECTOR     +lisp-abstract-vector-class+)))
+                            (SYMBOL     +lisp-symbol+)
+                            (CHARACTER  +lisp-character+)
+                            (CONS       +lisp-cons+)
+                            (HASH-TABLE +lisp-hash-table+)
+                            (FIXNUM     +lisp-fixnum+)
+                            (STREAM     +lisp-stream+)
+                            (STRING     +lisp-abstract-string+)
+                            (VECTOR     +lisp-abstract-vector+)))
         (expected-type-java-symbol-name (case expected-type
                                           (HASH-TABLE "HASH_TABLE")
@@ -781 +509 @@
         (LABEL1 (gensym)))
     (emit-load-local-variable variable)
-    (emit 'instanceof instanceof-class)
+    (emit-instanceof instanceof-class)
     (emit 'ifne LABEL1)
     (emit-load-local-variable variable)
-    (emit-getstatic +lisp-symbol-class+ expected-type-java-symbol-name
+    (emit-getstatic +lisp-symbol+ expected-type-java-symbol-name
           +lisp-symbol+)
-    (emit-invokestatic +lisp-class+ "type_error"
+    (emit-invokestatic +lisp+ "type_error"
                        (lisp-object-arg-types 2) +lisp-object+)
-    (emit 'pop) ; Needed for JVM stack consistency.
+    (emit 'areturn) ; Needed for JVM stack consistency.
     (label LABEL1))
   t)
@@ -844 +572 @@
   (unless (> *speed* *safety*)
     (let ((label1 (gensym)))
-      (emit-getstatic +lisp-class+ "interrupted" "Z")
+      (emit-getstatic +lisp+ "interrupted" :boolean)
       (emit 'ifeq label1)
-      (emit-invokestatic +lisp-class+ "handleInterrupt" nil nil)
+      (emit-invokestatic +lisp+ "handleInterrupt" nil nil)
       (label label1))))
 
@@ -900 +628 @@
   (declare (optimize speed (safety 0)))
   (ensure-thread-var-initialized)
-  (emit 'clear-values))
+  (emit 'clear-values *thread*))
 
 (defknown maybe-emit-clear-values (&rest t) t)
@@ -908 +636 @@
     (unless (single-valued-p form)
       (ensure-thread-var-initialized)
-      (emit 'clear-values)
+      (emit 'clear-values *thread*)
       (return))))
 
@@ -922 +650 @@
   (declare (optimize speed))
   (cond ((= *safety* 3)
-         (emit-invokestatic +lisp-fixnum-class+ "getValue"
-                            (lisp-object-arg-types 1) "I"))
+         (emit-invokestatic +lisp-fixnum+ "getValue"
+                            (lisp-object-arg-types 1) :int))
         (t
-         (emit 'checkcast +lisp-fixnum-class+)
-         (emit 'getfield +lisp-fixnum-class+ "value" "I"))))
+         (emit-checkcast +lisp-fixnum+)
+         (emit-getfield +lisp-fixnum+ "value" :int))))
 
 (defknown emit-unbox-long () t)
 (defun emit-unbox-long ()
-  (emit-invokestatic +lisp-bignum-class+ "longValue"
-                     (lisp-object-arg-types 1) "J"))
+  (emit-invokestatic +lisp-bignum+ "longValue"
+                     (lisp-object-arg-types 1) :long))
 
 (defknown emit-unbox-float () t)
@@ -937 +665 @@
   (declare (optimize speed))
   (cond ((= *safety* 3)
-         (emit-invokestatic +lisp-single-float-class+ "getValue"
-                            (lisp-object-arg-types 1) "F"))
+         (emit-invokestatic +lisp-single-float+ "getValue"
+                            (lisp-object-arg-types 1) :float))
         (t
-         (emit 'checkcast +lisp-single-float-class+)
-         (emit 'getfield +lisp-single-float-class+ "value" "F"))))
+         (emit-checkcast +lisp-single-float+)
+         (emit-getfield +lisp-single-float+ "value" :float))))
 
 (defknown emit-unbox-double () t)
@@ -947 +675 @@
   (declare (optimize speed))
   (cond ((= *safety* 3)
-         (emit-invokestatic +lisp-double-float-class+ "getValue"
-                            (lisp-object-arg-types 1) "D"))
+         (emit-invokestatic +lisp-double-float+ "getValue"
+                            (lisp-object-arg-types 1) :double))
         (t
-         (emit 'checkcast +lisp-double-float-class+)
-         (emit 'getfield +lisp-double-float-class+ "value" "D"))))
+         (emit-checkcast +lisp-double-float+)
+         (emit-getfield +lisp-double-float+ "value" :double))))
 
 (defknown fix-boxing (t t) t)
@@ -961 +689 @@
          (cond ((and (fixnum-type-p derived-type)
                      (< *safety* 3))
-                (emit 'checkcast +lisp-fixnum-class+)
-                (emit 'getfield +lisp-fixnum-class+ "value" "I"))
+                (emit-checkcast +lisp-fixnum+)
+                (emit-getfield +lisp-fixnum+ "value" :int))
                (t
-                (emit-invokevirtual +lisp-object-class+ "intValue" nil "I"))))
+                (emit-invokevirtual +lisp-object+ "intValue" nil :int))))
         ((eq required-representation :char)
          (emit-unbox-character))
@@ -970 +698 @@
          (emit-unbox-boolean))
         ((eq required-representation :long)
-         (emit-invokevirtual +lisp-object-class+ "longValue" nil "J"))
+         (emit-invokevirtual +lisp-object+ "longValue" nil :long))
         ((eq required-representation :float)
-         (emit-invokevirtual +lisp-object-class+ "floatValue" nil "F"))
+         (emit-invokevirtual +lisp-object+ "floatValue" nil :float))
         ((eq required-representation :double)
-         (emit-invokevirtual +lisp-object-class+ "doubleValue" nil "D"))
+         (emit-invokevirtual +lisp-object+ "doubleValue" nil :double))
         (t (assert nil))))
 
@@ -1004 +732 @@
 (defknown emit-invoke-method (t t t) t)
 (defun emit-invoke-method (method-name target representation)
-  (emit-invokevirtual +lisp-object-class+ method-name nil +lisp-object+)
+  (emit-invokevirtual +lisp-object+ method-name nil +lisp-object+)
   (fix-boxing representation nil)
   (emit-move-from-stack target representation))
@@ -1040 +768 @@
   (check-number-of-args form n t))
 
-(defun unsupported-opcode (instruction)
-  (error "Unsupported opcode ~D." (instruction-opcode instruction)))
-
-(declaim (type hash-table +resolvers+))
-(defconst +resolvers+ (make-hash-table))
-
-(defun initialize-resolvers ()
-  (let ((ht +resolvers+))
-    (dotimes (n (1+ *last-opcode*))
-      (setf (gethash n ht) #'unsupported-opcode))
-    ;; The following opcodes resolve to themselves.
-    (dolist (n '(0 ; nop
-                 1 ; aconst_null
-                 2 ; iconst_m1
-                 3 ; iconst_0
-                 4 ; iconst_1
-                 5 ; iconst_2
-                 6 ; iconst_3
-                 7 ; iconst_4
-                 8 ; iconst_5
-                 9 ; lconst_0
-                 10 ; lconst_1
-                 11 ; fconst_0
-                 12 ; fconst_1
-                 13 ; fconst_2
-                 14 ; dconst_0
-                 15 ; dconst_1
-                 42 ; aload_0
-                 43 ; aload_1
-                 44 ; aload_2
-                 45 ; aload_3
-                 46 ; iaload
-                 47 ; laload
-                 48 ; faload
-                 49 ; daload
-                 50 ; aaload
-                 75 ; astore_0
-                 76 ; astore_1
-                 77 ; astore_2
-                 78 ; astore_3
-                 79 ; iastore
-                 80 ; lastore
-                 81 ; fastore
-                 82 ; dastore
-                 83 ; aastore
-                 87 ; pop
-                 88 ; pop2
-                 89 ; dup
-                 90 ; dup_x1
-                 91 ; dup_x2
-                 92 ; dup2
-                 93 ; dup2_x1
-                 94 ; dup2_x2
-                 95 ; swap
-                 96 ; iadd
-                 97 ; ladd
-                 98 ; fadd
-                 99 ; dadd
-                 100 ; isub
-                 101 ; lsub
-                 102 ; fsub
-                 103 ; dsub
-                 104 ; imul
-                 105 ; lmul
-                 106 ; fmul
-                 107 ; dmul
-                 116 ; ineg
-                 117 ; lneg
-                 118 ; fneg
-                 119 ; dneg
-                 120 ; ishl
-                 121 ; lshl
-                 122 ; ishr
-                 123 ; lshr
-                 126 ; iand
-                 127 ; land
-                 128 ; ior
-                 129 ; lor
-                 130 ; ixor
-                 131 ; lxor
-                 133 ; i2l
-                 134 ; i2f
-                 135 ; i2d
-                 136 ; l2i
-                 137 ; l2f
-                 138 ; l2d
-                 141 ; f2d
-                 144 ; d2f
-                 148 ; lcmp
-                 149 ; fcmpd
-                 150 ; fcmpg
-                 151 ; dcmpd
-                 152 ; dcmpg
-                 153 ; ifeq
-                 154 ; ifne
-                 155 ; ifge
-                 156 ; ifgt
-                 157 ; ifgt
-                 158 ; ifle
-                 159 ; if_icmpeq
-                 160 ; if_icmpne
-                 161 ; if_icmplt
-                 162 ; if_icmpge
-                 163 ; if_icmpgt
-                 164 ; if_icmple
-                 165 ; if_acmpeq
-                 166 ; if_acmpne
-                 167 ; goto
-                 176 ; areturn
-                 177 ; return
-                 190 ; arraylength
-                 191 ; athrow
-                 194 ; monitorenter
-                 195 ; monitorexit
-                 198 ; ifnull
-                 202 ; label
-                 ))
-      (setf (gethash n ht) nil))))
-
-(initialize-resolvers)
-
-(defmacro define-resolver (opcodes args &body body)
-  (let ((name (gensym)))
-    `(progn
-       (defun ,name ,args ,@body)
-       (eval-when (:load-toplevel :execute)
-   ,(if (listp opcodes)
-        `(dolist (op ',opcodes)
-     (setf (gethash op +resolvers+) (symbol-function ',name)))
-        `(setf (gethash ,opcodes +resolvers+) (symbol-function ',name)))))))
-
-(defun load/store-resolver (instruction inst-index inst-index2 error-text)
- (let* ((args (instruction-args instruction))
-        (index (car args)))
-   (declare (type (unsigned-byte 16) index))
-   (cond ((<= 0 index 3)
-          (inst (+ index inst-index)))
-         ((<= 0 index 255)
-          (inst inst-index2 index))
-         (t
-          (error error-text)))))
-
-;; aload
-(define-resolver 25 (instruction)
-  (load/store-resolver instruction 42 25 "ALOAD unsupported case"))
-
-;; astore
-(define-resolver 58 (instruction)
-  (load/store-resolver instruction 75 58 "ASTORE unsupported case"))
-
-;; iload
-(define-resolver 21 (instruction)
-  (load/store-resolver instruction 26 21 "ILOAD unsupported case"))
-
-;; istore
-(define-resolver 54 (instruction)
-  (load/store-resolver instruction 59 54 "ISTORE unsupported case"))
-
-;; lload
-(define-resolver 22 (instruction)
-  (load/store-resolver instruction 30 22 "LLOAD unsupported case"))
-
-;; lstore
-(define-resolver 55 (instruction)
-  (load/store-resolver instruction 63 55 "LSTORE unsupported case"))
-
-;; getstatic, putstatic
-(define-resolver (178 179) (instruction)
-  ;; we used to create the pool-field here; that moved to the emit-* layer
-  instruction)
-
-;; bipush, sipush
-(define-resolver (16 17) (instruction)
-  (let* ((args (instruction-args instruction))
-         (n (first args)))
-    (declare (type fixnum n))
-    (cond ((<= 0 n 5)
-           (inst (+ n 3)))
-          ((<= -128 n 127)
-           (inst 16 (logand n #xff))) ; BIPUSH
-          (t ; SIPUSH
-           (inst 17 (s2 n))))))
-
-;; invokevirtual, invokespecial, invokestatic class-name method-name descriptor
-(define-resolver (182 183 184) (instruction)
-  ;; we used to create the pool-method here; that moved to the emit-* layer
-  instruction)
-
-;; ldc
-(define-resolver 18 (instruction)
-  (let* ((args (instruction-args instruction)))
-    (unless (= (length args) 1)
-      (error "Wrong number of args for LDC."))
-    (if (> (car args) 255)
-        (inst 19 (u2 (car args))) ; LDC_W
-        (inst 18 args))))
-
-;; ldc2_w
-(define-resolver 20 (instruction)
-  (let* ((args (instruction-args instruction)))
-    (unless (= (length args) 1)
-      (error "Wrong number of args for LDC2_W."))
-    (inst 20 (u2 (car args)))))
-
-;; getfield, putfield class-name field-name type-name
-(define-resolver (180 181) (instruction)
-  (let* ((args (instruction-args instruction))
-         (index (pool-field (first args) (second args) (third args))))
-    (inst (instruction-opcode instruction) (u2 index))))
-
-;; new, anewarray, checkcast, instanceof class-name
-(define-resolver (187 189 192 193) (instruction)
-  (let* ((args (instruction-args instruction))
-         (index (pool-class (first args))))
-    (inst (instruction-opcode instruction) (u2 index))))
-
-;; iinc
-(define-resolver 132 (instruction)
-  (let* ((args (instruction-args instruction))
-         (register (first args))
-         (n (second args)))
-    (when (not (<= -128 n 127))
-      (error "IINC argument ~A out of bounds." n))
-    (inst 132 (list register (s1 n)))))
-
-(defknown resolve-instruction (t) t)
-(defun resolve-instruction (instruction)
-  (declare (optimize speed))
-  (let ((resolver (gethash1 (instruction-opcode instruction) +resolvers+)))
-    (if resolver
-        (funcall resolver instruction)
-        instruction)))
-
-(defun resolve-instructions (code)
-  (let ((vector (make-array 512 :fill-pointer 0 :adjustable t)))
-    (dotimes (index (length code) vector)
-      (declare (type (unsigned-byte 16) index))
-      (let ((instruction (svref code index)))
-        (case (instruction-opcode instruction)
-          (205 ; CLEAR-VALUES
-           (let ((instructions
-                  (list
-                   (inst 'aload *thread*)
-                   (inst 'aconst_null)
-                   (inst 'putfield (list +lisp-thread-class+ "_values"
-                                         +lisp-object-array+)))))
-             (dolist (instruction instructions)
-               (vector-push-extend (resolve-instruction instruction) vector))))
-          (t
-           (vector-push-extend (resolve-instruction instruction) vector)))))))
-
-(declaim (ftype (function (t) t) branch-opcode-p))
-(declaim (inline branch-opcode-p))
-(defun branch-opcode-p (opcode)
-  (declare (optimize speed))
-  (declare (type '(integer 0 255) opcode))
-  (or (<= 153 opcode 168)
-      (= opcode 198)))
-
-(declaim (ftype (function (t t t) t) walk-code))
-(defun walk-code (code start-index depth)
-  (declare (optimize speed))
-  (declare (type fixnum start-index depth))
-  (do* ((i start-index (1+ i))
-        (limit (length code)))
-       ((>= i limit))
-    (declare (type fixnum i limit))
-    (let* ((instruction (aref code i))
-           (instruction-depth (instruction-depth instruction))
-           (instruction-stack (instruction-stack instruction)))
-      (declare (type fixnum instruction-stack))
-      (when instruction-depth
-        (unless (= (the fixnum instruction-depth) (the fixnum (+ depth instruction-stack)))
-          (internal-compiler-error 
-           "Stack inconsistency detected in ~A at index ~D: found ~S, expected ~S." 
-           (compiland-name *current-compiland*)
-           i instruction-depth (+ depth instruction-stack)))
-        (return-from walk-code))
-      (let ((opcode (instruction-opcode instruction)))
-        (setf depth (+ depth instruction-stack))
-        (setf (instruction-depth instruction) depth)
-        (when (branch-opcode-p opcode)
-          (let ((label (car (instruction-args instruction))))
-            (declare (type symbol label))
-            (walk-code code (symbol-value label) depth)))
-        (when (member opcode '(167 176 191)) ; GOTO ARETURN ATHROW
-          ;; Current path ends.
-          (return-from walk-code))))))
-
-(declaim (ftype (function () t) analyze-stack))
-(defun analyze-stack ()
-  (declare (optimize speed))
-  (let* ((code *code*)
-         (code-length (length code)))
-    (declare (type vector code))
-    (dotimes (i code-length)
-      (declare (type (unsigned-byte 16) i))
-      (let* ((instruction (aref code i))
-             (opcode (instruction-opcode instruction)))
-        (when (eql opcode 202) ; LABEL
-          (let ((label (car (instruction-args instruction))))
-            (set label i)))
-        (if (instruction-stack instruction)
-            (when (opcode-stack-effect opcode)
-              (unless (eql (instruction-stack instruction) (opcode-stack-effect opcode))
-                (sys::%format t "instruction-stack = ~S opcode-stack-effect = ~S~%"
-                         (instruction-stack instruction)
-                         (opcode-stack-effect opcode))
-                (sys::%format t "index = ~D instruction = ~A~%" i (print-instruction instruction))))
-            (setf (instruction-stack instruction) (opcode-stack-effect opcode)))
-        (unless (instruction-stack instruction)
-          (sys::%format t "no stack information for instruction ~D~%" (instruction-opcode instruction))
-          (aver nil))))
-    (walk-code code 0 0)
-    (dolist (handler *handlers*)
-      ;; Stack depth is always 1 when handler is called.
-      (walk-code code (symbol-value (handler-code handler)) 1))
-    (let ((max-stack 0))
-      (declare (type fixnum max-stack))
-      (dotimes (i code-length)
-        (declare (type (unsigned-byte 16) i))
-        (let* ((instruction (aref code i))
-               (instruction-depth (instruction-depth instruction)))
-          (when instruction-depth
-            (setf max-stack (max max-stack (the fixnum instruction-depth))))))
-      max-stack)))
-
-
-(defun finalize-code ()
-  (setf *code* (nreverse (coerce *code* 'vector))))
-
-(defun print-code ()
-  (dotimes (i (length *code*))
-    (let ((instruction (elt *code* i)))
-      (sys::%format t "~D ~A ~S ~S ~S~%"
-                    i
-                    (opcode-name (instruction-opcode instruction))
-                    (instruction-args instruction)
-                    (instruction-stack instruction)
-                    (instruction-depth instruction)))))
-
-(defun print-code2 (code)
-  (dotimes (i (length code))
-    (let ((instruction (elt code i)))
-      (case (instruction-opcode instruction)
-        (202 ; LABEL
-         (format t "~A:~%" (car (instruction-args instruction))))
-        (t
-         (format t "~8D:   ~A ~S~%"
-                 i
-                 (opcode-name (instruction-opcode instruction))
-                 (instruction-args instruction)))))))
-
-(declaim (ftype (function (t) boolean) label-p))
-(defun label-p (instruction)
-  (and instruction
-       (= (the fixnum (instruction-opcode (the instruction instruction))) 202)))
-
-(declaim (ftype (function (t) t) instruction-label))
-(defun instruction-label (instruction)
-  (and instruction
-       (= (instruction-opcode (the instruction instruction)) 202)
-       (car (instruction-args instruction))))
-
-;; Remove unused labels.
-(defun optimize-1 ()
-  (let ((code (coerce *code* 'vector))
-        (changed nil)
-        (marker (gensym)))
-    ;; Mark the labels that are actually branched to.
-    (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
-      (let ((instruction (aref code i)))
-        (when (branch-opcode-p (instruction-opcode instruction))
-          (let ((label (car (instruction-args instruction))))
-            (set label marker)))))
-    ;; Add labels used for exception handlers.
-    (dolist (handler *handlers*)
-      (set (handler-from handler) marker)
-      (set (handler-to handler) marker)
-      (set (handler-code handler) marker))
-    ;; Remove labels that are not used as branch targets.
-    (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
-      (let ((instruction (aref code i)))
-        (when (= (instruction-opcode instruction) 202) ; LABEL
-          (let ((label (car (instruction-args instruction))))
-            (declare (type symbol label))
-            (unless (eq (symbol-value label) marker)
-              (setf (aref code i) nil)
-              (setf changed t))))))
-    (when changed
-      (setf *code* (delete nil code))
-      t)))
-
-(defun optimize-2 ()
-  (let* ((code (coerce *code* 'vector))
-         (length (length code))
-         (changed nil))
-    (declare (type (unsigned-byte 16) length))
-    ;; Since we're looking at this instruction and the next one, we can stop
-    ;; one before the end.
-    (dotimes (i (1- length))
-      (declare (type (unsigned-byte 16) i))
-      (let ((instruction (aref code i)))
-        (when (and instruction (= (instruction-opcode instruction) 167)) ; GOTO
-          (do* ((j (1+ i) (1+ j))
-                (next-instruction (aref code j) (aref code j)))
-               ((>= j length))
-            (declare (type (unsigned-byte 16) j))
-            (when next-instruction
-              (cond ((= (instruction-opcode next-instruction) 167) ; GOTO
-                     (cond ((= j (1+ i))
-                            ;; Two GOTOs in a row: the second instruction is
-                            ;; unreachable.
-                            (setf (aref code j) nil)
-                            (setf changed t))
-                           ((eq (car (instruction-args next-instruction))
-                                (car (instruction-args instruction)))
-                            ;; We've reached another GOTO to the same destination.
-                            ;; We don't need the first GOTO; we can just fall
-                            ;; through to the second one.
-                            (setf (aref code i) nil)
-                            (setf changed t)))
-                     (return))
-                    ((= (instruction-opcode next-instruction) 202) ; LABEL
-                     (when (eq (car (instruction-args instruction))
-                               (car (instruction-args next-instruction)))
-                       ;; GOTO next instruction; we don't need this one.
-                       (setf (aref code i) nil)
-                       (setf changed t)
-                       (return)))
-                    (t
-                     ;; Not a GOTO or a label.
-                     (return))))))))
-    (when changed
-      (setf *code* (delete nil code))
-      t)))
-
-(declaim (ftype (function (t) hash-table) hash-labels))
-(defun hash-labels (code)
-  (let ((ht (make-hash-table :test 'eq))
-        (code (coerce code 'vector))
-        (pending-labels '()))
-    (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
-      (let ((instruction (aref code i)))
-        (cond ((label-p instruction)
-               (push (instruction-label instruction) pending-labels))
-              (t
-               ;; Not a label.
-               (when pending-labels
-                 (dolist (label pending-labels)
-                   (setf (gethash label ht) instruction))
-                 (setf pending-labels nil))))))
-    ht))
-
-(defun optimize-2b ()
-  (let* ((code (coerce *code* 'vector))
-         (ht (hash-labels code))
-         (changed nil))
-    (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
-      (let ((instruction (aref code i)))
-        (when (and instruction (= (instruction-opcode instruction) 167)) ; GOTO
-          (let* ((target-label (car (instruction-args instruction)))
-                 (next-instruction (gethash1 target-label ht)))
-            (when next-instruction
-              (case (instruction-opcode next-instruction)
-                (167 ; GOTO
-                 (setf (instruction-args instruction)
-                       (instruction-args next-instruction)
-                       changed t))
-                (176 ; ARETURN
-                 (setf (instruction-opcode instruction) 176
-                       (instruction-args instruction) nil
-                       changed t))))))))
-    (when changed
-      (setf *code* code)
-      t)))
-
-;; CLEAR-VALUES CLEAR-VALUES => CLEAR-VALUES
-;; GETSTATIC POP => nothing
-(defun optimize-3 ()
-  (let* ((code (coerce *code* 'vector))
-         (changed nil))
-    (dotimes (i (1- (length code)))
-      (declare (type (unsigned-byte 16) i))
-      (let* ((this-instruction (aref code i))
-             (this-opcode (and this-instruction (instruction-opcode this-instruction)))
-             (next-instruction (aref code (1+ i)))
-             (next-opcode (and next-instruction (instruction-opcode next-instruction))))
-        (case this-opcode
-          (205 ; CLEAR-VALUES
-           (when (eql next-opcode 205) ; CLEAR-VALUES
-             (setf (aref code i) nil)
-             (setf changed t)))
-          (178 ; GETSTATIC
-           (when (eql next-opcode 87) ; POP
-             (setf (aref code i) nil)
-             (setf (aref code (1+ i)) nil)
-             (setf changed t))))))
-    (when changed
-      (setf *code* (delete nil code))
-      t)))
-
-(defun delete-unreachable-code ()
-  ;; Look for unreachable code after GOTO.
-  (let* ((code (coerce *code* 'vector))
-         (changed nil)
-         (after-goto/areturn nil))
-    (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
-      (let* ((instruction (aref code i))
-             (opcode (instruction-opcode instruction)))
-        (cond (after-goto/areturn
-               (if (= opcode 202) ; LABEL
-                   (setf after-goto/areturn nil)
-                   ;; Unreachable.
-                   (progn
-                     (setf (aref code i) nil)
-                     (setf changed t))))
-              ((= opcode 176) ; ARETURN
-               (setf after-goto/areturn t))
-              ((= opcode 167) ; GOTO
-               (setf after-goto/areturn t)))))
-    (when changed
-      (setf *code* (delete nil code))
-      t)))
-
-(defvar *enable-optimization* t)
-
-(defknown optimize-code () t)
-(defun optimize-code ()
-  (unless *enable-optimization*
-    (format t "optimizations are disabled~%"))
-  (when *enable-optimization*
-    (when *compiler-debug*
-      (format t "----- before optimization -----~%")
-      (print-code))
-    (loop
-      (let ((changed-p nil))
-        (setf changed-p (or (optimize-1) changed-p))
-        (setf changed-p (or (optimize-2) changed-p))
-        (setf changed-p (or (optimize-2b) changed-p))
-        (setf changed-p (or (optimize-3) changed-p))
-        (setf changed-p (or (delete-unreachable-code) changed-p))
-        (unless changed-p
-          (return))))
-    (unless (vectorp *code*)
-      (setf *code* (coerce *code* 'vector)))
-    (when *compiler-debug*
-      (sys::%format t "----- after optimization -----~%")
-      (print-code)))
-  t)
-
-(defun code-bytes (code)
-  (let ((length 0))
-    (declare (type (unsigned-byte 16) length))
-    ;; Pass 1: calculate label offsets and overall length.
-    (dotimes (i (length code))
-      (declare (type (unsigned-byte 16) i))
-      (let* ((instruction (aref code i))
-             (opcode (instruction-opcode instruction)))
-        (if (= opcode 202) ; LABEL
-            (let ((label (car (instruction-args instruction))))
-              (set label length))
-            (incf length (opcode-size opcode)))))
-    ;; Pass 2: replace labels with calculated offsets.
-    (let ((index 0))
-      (declare (type (unsigned-byte 16) index))
-      (dotimes (i (length code))
-        (declare (type (unsigned-byte 16) i))
-        (let ((instruction (aref code i)))
-          (when (branch-opcode-p (instruction-opcode instruction))
-            (let* ((label (car (instruction-args instruction)))
-                   (offset (- (the (unsigned-byte 16) (symbol-value (the symbol label))) index)))
-              (setf (instruction-args instruction) (s2 offset))))
-          (unless (= (instruction-opcode instruction) 202) ; LABEL
-            (incf index (opcode-size (instruction-opcode instruction)))))))
-    ;; Expand instructions into bytes, skipping LABEL pseudo-instructions.
-    (let ((bytes (make-array length))
-          (index 0))
-      (declare (type (unsigned-byte 16) index))
-      (dotimes (i (length code))
-        (declare (type (unsigned-byte 16) i))
-        (let ((instruction (aref code i)))
-          (unless (= (instruction-opcode instruction) 202) ; LABEL
-            (setf (svref bytes index) (instruction-opcode instruction))
-            (incf index)
-            (dolist (byte (instruction-args instruction))
-              (setf (svref bytes index) byte)
-              (incf index)))))
-      bytes)))
-
-(declaim (inline write-u1))
-(defun write-u1 (n stream)
-  (declare (optimize speed))
-  (declare (type (unsigned-byte 8) n))
-  (declare (type stream stream))
-  (write-8-bits n stream))
-
-(defknown write-u2 (t t) t)
-(defun write-u2 (n stream)
-  (declare (optimize speed))
-  (declare (type (unsigned-byte 16) n))
-  (declare (type stream stream))
-  (write-8-bits (logand (ash n -8) #xFF) stream)
-  (write-8-bits (logand n #xFF) stream))
-
-(defknown write-u4 (integer stream) t)
-(defun write-u4 (n stream)
-  (declare (optimize speed))
-  (declare (type (unsigned-byte 32) n))
-  (write-u2 (logand (ash n -16) #xFFFF) stream)
-  (write-u2 (logand n #xFFFF) stream))
-
-(declaim (ftype (function (t t) t) write-s4))
-(defun write-s4 (n stream)
-  (declare (optimize speed))
-  (cond ((minusp n)
-         (write-u4 (1+ (logxor (- n) #xFFFFFFFF)) stream))
-        (t
-         (write-u4 n stream))))
-
-(declaim (ftype (function (t t t) t) write-ascii))
-(defun write-ascii (string length stream)
-  (declare (type string string))
-  (declare (type (unsigned-byte 16) length))
-  (declare (type stream stream))
-  (write-u2 length stream)
-  (dotimes (i length)
-    (declare (type (unsigned-byte 16) i))
-    (write-8-bits (char-code (char string i)) stream)))
-
-(declaim (ftype (function (t t) t) write-utf8))
-(defun write-utf8 (string stream)
-  (declare (optimize speed))
-  (declare (type string string))
-  (declare (type stream stream))
-  (let ((length (length string))
-        (must-convert nil))
-    (declare (type fixnum length))
-    (dotimes (i length)
-      (declare (type fixnum i))
-      (unless (< 0 (char-code (char string i)) #x80)
-        (setf must-convert t)
-        (return)))
-    (if must-convert
-        (let ((octets (make-array (* length 2)
-                                  :element-type '(unsigned-byte 8)
-                                  :adjustable t
-                                  :fill-pointer 0)))
-          (declare (type (vector (unsigned-byte 8)) octets))
-          (dotimes (i length)
-            (declare (type fixnum i))
-            (let* ((c (char string i))
-                   (n (char-code c)))
-              (cond ((zerop n)
-                     (vector-push-extend #xC0 octets)
-                     (vector-push-extend #x80 octets))
-                    ((< 0 n #x80)
-                     (vector-push-extend n octets))
-                    (t
-                     (let ((char-octets (char-to-utf8 c)))
-                       (dotimes (j (length char-octets))
-                         (declare (type fixnum j))
-                         (vector-push-extend (svref char-octets j) octets)))))))
-          (write-u2 (length octets) stream)
-          (dotimes (i (length octets))
-            (declare (type fixnum i))
-            (write-8-bits (aref octets i) stream)))
-        (write-ascii string length stream))))
-
-(defknown write-constant-pool-entry (t t) t)
-(defun write-constant-pool-entry (entry stream)
-  (declare (optimize speed))
-  (declare (type stream stream))
-  (let ((tag (first entry)))
-    (declare (type (integer 1 12) tag))
-    (write-u1 tag stream)
-    (case tag
-      (1 ; UTF8
-       (write-utf8 (third entry) stream))
-      ((3 4) ; int
-       (write-u4 (second entry) stream))
-      ((5 6) ; long double
-       (write-u4 (second entry) stream)
-       (write-u4 (third entry) stream))
-      ((9 10 11 12) ; fieldref methodref InterfaceMethodref nameAndType
-       (write-u2 (second entry) stream)
-       (write-u2 (third entry) stream))
-      ((7 8) ; class string
-       (write-u2 (second entry) stream))
-      (t
-       (error "write-constant-pool-entry unhandled tag ~D~%" tag)))))
-
-(defun write-constant-pool (stream)
-  (declare (optimize speed))
-  (write-u2 *pool-count* stream)
-  (dolist (entry (reverse *pool*))
-    (write-constant-pool-entry entry stream)))
-
-(defstruct (field (:constructor make-field (name descriptor)))
-  access-flags
-  name
-  descriptor
-  name-index
-  descriptor-index)
-
-(defstruct (java-method (:conc-name method-) (:constructor %make-method))
-  access-flags
-  name
-  descriptor
-  name-index
-  descriptor-index
-  max-stack
-  max-locals
-  code
-  handlers)
-
-(defun make-method (&rest args &key descriptor name
-                                    descriptor-index name-index
-                               &allow-other-keys)
-  (apply #'%make-method
-         (list* :descriptor-index (or descriptor-index (pool-name descriptor))
-                :name-index (or name-index (pool-name name))
-                args)))
+
 
 (defun emit-constructor-lambda-name (lambda-name)
@@ -1773 +774 @@
          (emit 'ldc (pool-string (symbol-name (truly-the symbol lambda-name))))
          (emit 'ldc (pool-string (package-name (symbol-package (truly-the symbol lambda-name)))))
-         (emit-invokestatic +lisp-class+ "internInPackage"
-                            (list +java-string+ +java-string+) +lisp-symbol+))
+         (emit-invokestatic +lisp+ "internInPackage"
+                            (list +java-string+ +java-string+)
+                            +lisp-symbol+))
         (t
          ;; No name.
@@ -1785 +787 @@
              (s (sys::%format nil "~S" lambda-list)))
         (emit 'ldc (pool-string s))
-        (emit-invokestatic +lisp-class+ "readObjectFromString"
+        (emit-invokestatic +lisp+ "readObjectFromString"
                            (list +java-string+) +lisp-object+))
       (emit-push-nil)))
@@ -1795 +797 @@
   (let* ((*compiler-debug* nil)
          ;; We don't normally need to see debugging output for constructors.
-         (constructor (make-method :name "<init>"
-                                   :descriptor "()V"))
+         (method (make-method :constructor :void nil
+                              :flags '(:public)))
+         (code (method-add-code method))
          req-params-register
          opt-params-register
@@ -1804 +807 @@
          more-keys-p
          (*code* ())
-         (*handlers* nil))
-    (setf (method-max-locals constructor) 1)
-    (unless (equal super +lisp-primitive-class+)
+         (*current-code-attribute* code))
+    (setf (code-max-locals code) 1)
+    (unless (eq super +lisp-primitive+)
       (multiple-value-bind
             (req opt key key-p rest
@@ -1819 +822 @@
                  `(progn
                     (emit-push-constant-int (length ,params))
-                    (emit 'anewarray +lisp-closure-parameter-class+)
-                    (astore (setf ,register (method-max-locals constructor)))
-                    (incf (method-max-locals constructor))
+                    (emit-anewarray +lisp-closure-parameter+)
+                    (astore (setf ,register (code-max-locals code)))
+                    (incf (code-max-locals code))
                     (do* ((,count-sym 0 (1+ ,count-sym))
                           (,params ,params (cdr ,params))
@@ -1829 +832 @@
                       (aload ,register)
                       (emit-push-constant-int ,count-sym)
-                      (emit 'new +lisp-closure-parameter-class+)
+                      (emit-new +lisp-closure-parameter+)
                       (emit 'dup)
                       ,@body
@@ -1836 +839 @@
           (parameters-to-array (ignore req req-params-register)
              (emit-push-t) ;; we don't need the actual symbol
-             (emit-invokespecial-init +lisp-closure-parameter-class+
+             (emit-invokespecial-init +lisp-closure-parameter+
                                       (list +lisp-symbol+)))
 
@@ -1845 +848 @@
                  (emit-push-nil)
                  (emit-push-t)) ;; we don't need the actual supplied-p symbol
-             (emit-getstatic +lisp-closure-class+ "OPTIONAL" "I")
-             (emit-invokespecial-init +lisp-closure-parameter-class+
+             (emit-getstatic +lisp-closure+ "OPTIONAL" :int)
+             (emit-invokespecial-init +lisp-closure-parameter+
                                       (list +lisp-symbol+ +lisp-object+
-                                            +lisp-object+ "I")))
+                                            +lisp-object+ :int)))
 
           (parameters-to-array (param key key-params-register)
@@ -1855 +858 @@
                    (progn
                      (emit 'ldc (pool-string (symbol-name keyword)))
-                     (emit-invokestatic +lisp-class+ "internKeyword"
+                     (emit-invokestatic +lisp+ "internKeyword"
                                         (list +java-string+) +lisp-symbol+))
                    ;; symbol is not really a keyword; yes, that's allowed!
@@ -1862 +865 @@
                      (emit 'ldc (pool-string
                                  (package-name (symbol-package keyword))))
-                     (emit-invokestatic +lisp-class+ "internInPackage"
+                     (emit-invokestatic +lisp+ "internInPackage"
                                         (list +java-string+ +java-string+)
                                         +lisp-symbol+))))
@@ -1870 +873 @@
                  (emit-push-nil)
                  (emit-push-t)) ;; we don't need the actual supplied-p symbol
-             (emit-invokespecial-init +lisp-closure-parameter-class+
+             (emit-invokespecial-init +lisp-closure-parameter+
                                       (list +lisp-symbol+ +lisp-symbol+
                                             +lisp-object+ +lisp-object+))))))
     (aload 0) ;; this
-    (cond ((equal super +lisp-primitive-class+)
+    (cond ((eq super +lisp-primitive+)
            (emit-constructor-lambda-name lambda-name)
            (emit-constructor-lambda-list args)
            (emit-invokespecial-init super (lisp-object-arg-types 2)))
-          ((equal super +lisp-compiled-closure-class+)
+          ((equal super +lisp-compiled-closure+) ;;### only needs EQ when SUPER is guaranteed to be CLASS-NAME
            (aload req-params-register)
            (aload opt-params-register)
@@ -1901 +904 @@
     (setf *code* (append *static-code* *code*))
     (emit 'return)
-    (finalize-code)
-    (setf *code* (resolve-instructions *code*))
-    (setf (method-max-stack constructor) (analyze-stack))
-    (setf (method-code constructor) (code-bytes *code*))
-    (setf (method-handlers constructor) (nreverse *handlers*))
-    constructor))
-
-(defun write-exception-table (method stream)
-  (let ((handlers (method-handlers method)))
-    (write-u2 (length handlers) stream) ; number of entries
-    (dolist (handler handlers)
-      (write-u2 (symbol-value (handler-from handler)) stream)
-      (write-u2 (symbol-value (handler-to handler)) stream)
-      (write-u2 (symbol-value (handler-code handler)) stream)
-      (write-u2 (handler-catch-type handler) stream))))
-
-(defun write-source-file-attr (source-file stream)
-  (let* ((name-index (pool-name "SourceFile"))
-         (source-file-index (pool-name source-file)))
-    (write-u2 name-index stream)
-    ;; "The value of the attribute_length item of a SourceFile_attribute
-    ;; structure must be 2."
-    (write-u4 2 stream)
-    (write-u2 source-file-index stream)))
+    (setf (code-code code) *code*)
+    method))
+
 
 (defvar *source-line-number* nil)
 
-(defun write-line-number-table (stream)
-  (let* ((name-index (pool-name "LineNumberTable")))
-    (write-u2 name-index stream)
-    (write-u4 6 stream) ; "the length of the attribute, excluding the initial six bytes"
-    (write-u2 1 stream) ; number of entries
-    (write-u2 0 stream) ; start_pc
-    (write-u2 *source-line-number* stream)))
-
-(defun write-code-attr (method stream)
-  (declare (optimize speed))
-  (declare (type stream stream))
-  (let* ((name-index (pool-name "Code"))
-         (code (method-code method))
-         (code-length (length code))
-         (line-number-available-p (and (fixnump *source-line-number*)
-                                       (plusp *source-line-number*)))
-         (length (+ code-length 12
-                    (* (length (method-handlers method)) 8)
-                    (if line-number-available-p 12 0)))
-         (max-stack (or (method-max-stack method) 20))
-         (max-locals (or (method-max-locals method) 1)))
-    (write-u2 name-index stream)
-    (write-u4 length stream)
-    (write-u2 max-stack stream)
-    (write-u2 max-locals stream)
-    (write-u4 code-length stream)
-    (dotimes (i code-length)
-      (declare (type index i))
-      (write-u1 (the (unsigned-byte 8) (svref code i)) stream))
-    (write-exception-table method stream)
-    (cond (line-number-available-p
-           ; attributes count
-           (write-u2 1 stream)
-           (write-line-number-table stream))
-          (t
-           ; attributes count
-           (write-u2 0 stream)))))
-
-(defun write-method (method stream)
-  (declare (optimize speed))
-  (write-u2 (or (method-access-flags method) #x1) stream) ; access flags
-  (write-u2 (method-name-index method) stream)
-  (write-u2 (method-descriptor-index method) stream)
-  (write-u2 1 stream) ; attributes count
-  (write-code-attr method stream))
-
-(defun write-field (field stream)
-  (declare (optimize speed))
-  (write-u2 (or (field-access-flags field) #x1) stream) ; access flags
-  (write-u2 (field-name-index field) stream)
-  (write-u2 (field-descriptor-index field) stream)
-  (write-u2 0 stream)) ; attributes count
-
-(defconst +field-flag-final+       #x10) ;; final field
-(defconst +field-flag-static+      #x08) ;; static field
-(defconst +field-access-protected+ #x04) ;; subclass accessible
-(defconst +field-access-private+   #x02) ;; class-only accessible
-(defconst +field-access-public+    #x01) ;; generally accessible
-(defconst +field-access-default+   #x00) ;; package accessible, used for LABELS
+
+(defun finish-class (class stream)
+  "Finalizes the `class' and writes the result to `stream'.
+
+The compiler calls this function to indicate it doesn't want to
+extend the class any further."
+  (class-add-method class (make-constructor (class-file-superclass class)
+                                            (abcl-class-file-lambda-name class)
+                                            (abcl-class-file-lambda-list class)))
+  (finalize-class-file class)
+  (write-class-file class stream))
+
 
 (defknown declare-field (t t t) t)
-(defun declare-field (name descriptor access-flags)
-  (let ((field (make-field name descriptor)))
-    ;; final static <access-flags>
-    (setf (field-access-flags field)
-          (logior +field-flag-final+ +field-flag-static+ access-flags))
-    (setf (field-name-index field) (pool-name (field-name field)))
-    (setf (field-descriptor-index field) (pool-name (field-descriptor field)))
-    (push field *fields*)))
+(defun declare-field (name descriptor)
+  (let ((field (make-field name descriptor
+                           :flags '(:final :static :private))))
+    (class-add-field *class-file* field)))
 
 (defknown sanitize (symbol) string)
@@ -2043 +974 @@
   "Generates code to restore a serialized integer."
   (cond((<= 0 n 255)
-        (emit-getstatic +lisp-fixnum-class+ "constants" +lisp-fixnum-array+)
+        (emit-getstatic +lisp-fixnum+ "constants" +lisp-fixnum-array+)
         (emit-push-constant-int n)
         (emit 'aaload))
        ((<= most-negative-fixnum n most-positive-fixnum)
         (emit-push-constant-int n)
-        (emit-invokestatic +lisp-fixnum-class+ "getInstance"
-                           '("I") +lisp-fixnum+))
+        (emit-invokestatic +lisp-fixnum+ "getInstance"
+                           '(:int) +lisp-fixnum+))
        ((<= most-negative-java-long n most-positive-java-long)
         (emit-push-constant-long n)
-        (emit-invokestatic +lisp-bignum-class+ "getInstance"
-                           '("J") +lisp-integer+))
+        (emit-invokestatic +lisp-bignum+ "getInstance"
+                           '(:long) +lisp-integer+))
        (t
         (let* ((*print-base* 10)
@@ -2059 +990 @@
           (emit 'ldc (pool-string s))
           (emit-push-constant-int 10)
-          (emit-invokestatic +lisp-bignum-class+ "getInstance"
-                             (list +java-string+ "I") +lisp-integer+)))))
+          (emit-invokestatic +lisp-bignum+ "getInstance"
+                             (list +java-string+ :int) +lisp-integer+)))))
 
 (defun serialize-character (c)
   "Generates code to restore a serialized character."
   (emit-push-constant-int (char-code c))
-  (emit-invokestatic +lisp-character-class+ "getInstance" '("C")
+  (emit-invokestatic +lisp-character+ "getInstance" '(:char)
                      +lisp-character+))
 
 (defun serialize-float (s)
   "Generates code to restore a serialized single-float."
-  (emit 'new +lisp-single-float-class+)
+  (emit-new +lisp-single-float+)
   (emit 'dup)
   (emit 'ldc (pool-float s))
-  (emit-invokespecial-init +lisp-single-float-class+ '("F")))
+  (emit-invokespecial-init +lisp-single-float+ '(:float)))
 
 (defun serialize-double (d)
   "Generates code to restore a serialized double-float."
-  (emit 'new +lisp-double-float-class+)
+  (emit-new +lisp-double-float+)
   (emit 'dup)
   (emit 'ldc2_w (pool-double d))
-  (emit-invokespecial-init +lisp-double-float-class+ '("D")))
+  (emit-invokespecial-init +lisp-double-float+ '(:double)))
 
 (defun serialize-string (string)
   "Generate code to restore a serialized string."
-  (emit 'new +lisp-simple-string-class+)
+  (emit-new +lisp-simple-string+)
   (emit 'dup)
   (emit 'ldc (pool-string string))
-  (emit-invokespecial-init +lisp-simple-string-class+ (list +java-string+)))
+  (emit-invokespecial-init +lisp-simple-string+ (list +java-string+)))
 
 (defun serialize-package (pkg)
@@ -2093 +1024 @@
   (emit 'ldc (pool-string (concatenate 'string "#.(FIND-PACKAGE \""
                                        (package-name pkg) "\")")))
-  (emit-invokestatic +lisp-class+ "readObjectFromString"
+  (emit-invokestatic +lisp+ "readObjectFromString"
                      (list +java-string+) +lisp-object+))
 
@@ -2102 +1033 @@
              (dump-form object stream))))
     (emit 'ldc (pool-string s))
-    (emit-invokestatic +lisp-class+ "readObjectFromString"
+    (emit-invokestatic +lisp+ "readObjectFromString"
                        (list +java-string+) +lisp-object+)))
 
@@ -2115 +1046 @@
       ((null (symbol-package symbol))
        (emit-push-constant-int (dump-uninterned-symbol-index symbol))
-       (emit-invokestatic +lisp-load-class+ "getUninternedSymbol" '("I")
+       (emit-invokestatic +lisp-load+ "getUninternedSymbol" '(:int)
                           +lisp-object+)
-       (emit 'checkcast +lisp-symbol-class+))
+       (emit-checkcast +lisp-symbol+))
       ((keywordp symbol)
        (emit 'ldc (pool-string (symbol-name symbol)))
-       (emit-invokestatic +lisp-class+ "internKeyword"
+       (emit-invokestatic +lisp+ "internKeyword"
                           (list +java-string+) +lisp-symbol+))
       (t
        (emit 'ldc (pool-string (symbol-name symbol)))
        (emit 'ldc (pool-string (package-name (symbol-package symbol))))
-       (emit-invokestatic +lisp-class+ "internInPackage"
+       (emit-invokestatic +lisp+ "internInPackage"
                           (list +java-string+ +java-string+)
                           +lisp-symbol+)))))
@@ -2147 +1078 @@
 5. The type of the field to save the serialized result to")
 
-(defknown emit-load-externalized-object (t) string)
+(defknown emit-load-externalized-object (t &optional t) string)
 (defun emit-load-externalized-object (object &optional cast)
   "Externalizes `object' for use in a FASL.
@@ -2176 +1107 @@
         (emit-getstatic *this-class* (cdr existing) field-type)
         (when cast
-          (emit 'checkcast cast))
+          (emit-checkcast cast))
         (return-from emit-load-externalized-object field-type)))
 
     ;; We need to set up the serialized value
     (let ((field-name (symbol-name (gensym prefix))))
-      (declare-field field-name field-type +field-access-private+)
+      (declare-field field-name field-type)
       (push (cons object field-name) *externalized-objects*)
 
@@ -2189 +1120 @@
            (remember field-name object)
            (emit 'ldc (pool-string field-name))
-           (emit-invokestatic +lisp-class+ "recall"
+           (emit-invokestatic +lisp+ "recall"
                               (list +java-string+) +lisp-object+)
-           (when (string/= field-type +lisp-object+)
-             (emit 'checkcast (subseq field-type 1 (1- (length field-type)))))
+           (when (not (eq field-type +lisp-object+))
+             (emit-checkcast field-type))
            (emit-putstatic *this-class* field-name field-type)
            (setf *static-code* *code*)))
@@ -2206 +1137 @@
       (emit-getstatic *this-class* field-name field-type)
       (when cast
-        (emit 'checkcast cast))
+        (emit-checkcast cast))
       field-type)))
 
@@ -2218 +1149 @@
      (when s
        (setf f (concatenate 'string f "_" s))))
-   (declare-field f +lisp-object+ +field-access-private+)
+   (declare-field f +lisp-object+)
    (multiple-value-bind
          (name class)
@@ -2237 +1168 @@
              (progn ;; generated by the DECLARE-OBJECT*'s above
                (emit-getstatic class name +lisp-object+)
-               (emit 'checkcast +lisp-symbol-class+))
+               (emit-checkcast +lisp-symbol+))
              (emit-getstatic class name +lisp-symbol+))
-         (emit-invokevirtual +lisp-symbol-class+
+         (emit-invokevirtual +lisp-symbol+
                              (if setf
                                  "getSymbolSetfFunctionOrDie"
@@ -2246 +1177 @@
          ;; make sure we're not cacheing a proxied function
          ;; (AutoloadedFunctionProxy) by allowing it to resolve itself
-         (emit-invokevirtual +lisp-object-class+
+         (emit-invokevirtual +lisp-object+
                              "resolve" nil +lisp-object+)
          (emit-putstatic *this-class* f +lisp-object+)
@@ -2267 +1198 @@
    local-function *declared-functions* ht g
    (setf g (symbol-name (gensym "LFUN")))
-   (let* ((pathname (abcl-class-file-pathname (local-function-class-file local-function)))
-    (class-name (concatenate 'string "org/armedbear/lisp/" (pathname-name pathname)))
-    (*code* *static-code*))
+   (let* ((class-name (abcl-class-file-class-name
+                       (local-function-class-file local-function)))
+          (*code* *static-code*))
      ;; fixme *declare-inline*
-     (declare-field g +lisp-object+ +field-access-private+)
-     (emit 'new class-name)
+     (declare-field g +lisp-object+)
+     (emit-new class-name)
      (emit 'dup)
      (emit-invokespecial-init class-name '())
-
-     ;(emit 'ldc (pool-string (pathname-name pathname)))
-     ;(emit-invokestatic +fasl-loader-class+ "faslLoadFunction"
-     ;(list +java-string+) +lisp-object+)
-
-;     (emit 'ldc (pool-string (file-namestring pathname)))
-     
-;     (emit-invokestatic +lisp-function-proxy-class+ "loadPreloadedFunction"
-;     (list +java-string+) +lisp-object+)
      (emit-putstatic *this-class* g +lisp-object+)
      (setf *static-code* *code*)
@@ -2305 +1227 @@
       ;; strings may contain evaluated bits which may depend on
       ;; previous statements
-      (declare-field g +lisp-object+ +field-access-private+)
+      (declare-field g +lisp-object+)
       (emit 'ldc (pool-string s))
-      (emit-invokestatic +lisp-class+ "readObjectFromString"
+      (emit-invokestatic +lisp+ "readObjectFromString"
                          (list +java-string+) +lisp-object+)
       (emit-putstatic *this-class* g +lisp-object+)
@@ -2325 +1247 @@
       ;; lisp code in the string (think #.() syntax), of which the outcome
       ;; may depend on something which was declared inline
-      (declare-field g +lisp-object+ +field-access-private+)
+      (declare-field g +lisp-object+)
       (emit 'ldc (pool-string s))
-      (emit-invokestatic +lisp-class+ "readObjectFromString"
+      (emit-invokestatic +lisp+ "readObjectFromString"
                          (list +java-string+) +lisp-object+)
-      (emit-invokestatic +lisp-class+ "loadTimeValue"
+      (emit-invokestatic +lisp+ "loadTimeValue"
                          (lisp-object-arg-types 1) +lisp-object+)
       (emit-putstatic *this-class* g +lisp-object+)
@@ -2339 +1261 @@
     g))
 
-(declaim (ftype (function (t &optional t) string) declare-object))
-(defun declare-object (obj &optional (obj-ref +lisp-object+)
-                           obj-class)
+(declaim (ftype (function (t) string) declare-object))
+(defun declare-object (obj)
   "Stores the object OBJ in the object-lookup-table,
 loading the object value into a field upon class-creation time.
@@ -2350 +1271 @@
     (remember g obj)
     (let* ((*code* *static-code*))
-      (declare-field g obj-ref +field-access-private+)
+      (declare-field g +lisp-object+)
       (emit 'ldc (pool-string g))
-      (emit-invokestatic +lisp-class+ "recall"
+      (emit-invokestatic +lisp+ "recall"
                          (list +java-string+) +lisp-object+)
-      (when (and obj-class (string/= obj-class +lisp-object-class+))
-        (emit 'checkcast obj-class))
-      (emit-putstatic *this-class* g obj-ref)
+      (emit-putstatic *this-class* g +lisp-object+)
       (setf *static-code* *code*)
       g)))
@@ -2370 +1289 @@
            ((integerp form)
             (emit-load-externalized-object form)
-            (emit-invokevirtual +lisp-object-class+ "intValue" nil "I"))
+            (emit-invokevirtual +lisp-object+ "intValue" nil :int))
            (t
             (sys::%format t "compile-constant int representation~%")
@@ -2381 +1300 @@
            ((integerp form)
             (emit-load-externalized-object form)
-            (emit-invokevirtual +lisp-object-class+ "longValue" nil "J"))
+            (emit-invokevirtual +lisp-object+ "longValue" nil :long))
            (t
             (sys::%format t "compile-constant long representation~%")
@@ -2507 +1426 @@
              (ecase representation
                (:boolean
-                (emit-invokevirtual +lisp-object-class+
+                (emit-invokevirtual +lisp-object+
                                     unboxed-method-name
-                                    nil "Z"))
+                                    nil :boolean))
                ((NIL)
-                (emit-invokevirtual +lisp-object-class+
+                (emit-invokevirtual +lisp-object+
                                     boxed-method-name
                                     nil +lisp-object+)))
@@ -2579 +1498 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack nil)
-    (emit-invokevirtual +lisp-object-class+ op
+    (emit-invokevirtual +lisp-object+ op
       (lisp-object-arg-types 1) +lisp-object+)
     (fix-boxing representation nil)
@@ -2644 +1563 @@
 
 (defun emit-ifne-for-eql (representation instruction-type)
-  (emit-invokevirtual +lisp-object-class+ "eql" instruction-type "Z")
+  (emit-invokevirtual +lisp-object+ "eql" instruction-type :boolean)
   (convert-representation :boolean representation))
 
@@ -2670 +1589 @@
      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                   arg2 'stack :int)
-     (emit-ifne-for-eql representation '("I")))
+     (emit-ifne-for-eql representation '(:int)))
           ((fixnum-type-p type1)
      (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
                   arg2 'stack nil)
            (emit 'swap)
-     (emit-ifne-for-eql representation '("I")))
+     (emit-ifne-for-eql representation '(:int)))
           ((eq type2 'CHARACTER)
      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                   arg2 'stack :char)
-     (emit-ifne-for-eql representation '("C")))
+     (emit-ifne-for-eql representation '(:char)))
           ((eq type1 'CHARACTER)
      (compile-forms-and-maybe-emit-clear-values arg1 'stack :char
                   arg2 'stack nil)
            (emit 'swap)
-     (emit-ifne-for-eql representation '("C")))
+     (emit-ifne-for-eql representation '(:char)))
           (t
      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
@@ -2690 +1609 @@
            (ecase representation
              (:boolean
-              (emit-invokevirtual +lisp-object-class+ "eql"
-                                  (lisp-object-arg-types 1) "Z"))
+              (emit-invokevirtual +lisp-object+ "eql"
+                                  (lisp-object-arg-types 1) :boolean))
              ((NIL)
-              (emit-invokevirtual +lisp-object-class+ "EQL"
+              (emit-invokevirtual +lisp-object+ "EQL"
                                   (lisp-object-arg-types 1) +lisp-object+)))))
     (emit-move-from-stack target representation)))
@@ -2706 +1625 @@
            (compile-form arg1 'stack nil)
            (compile-form arg2 'stack nil)
-           (emit-invokestatic +lisp-class+ "memq"
-                              (lisp-object-arg-types 2) "Z")
+           (emit-invokestatic +lisp+ "memq"
+                              (lisp-object-arg-types 2) :boolean)
            (emit-move-from-stack target representation)))
         (t
@@ -2723 +1642 @@
            (compile-form arg2 'stack nil)
            (cond ((eq type1 'SYMBOL) ; FIXME
-                  (emit-invokestatic +lisp-class+ "memq"
-                                     (lisp-object-arg-types 2) "Z"))
+                  (emit-invokestatic +lisp+ "memq"
+                                     (lisp-object-arg-types 2) :boolean))
                  (t
-                  (emit-invokestatic +lisp-class+ "memql"
-                                     (lisp-object-arg-types 2) "Z")))
+                  (emit-invokestatic +lisp+ "memql"
+                                     (lisp-object-arg-types 2) :boolean)))
            (emit-move-from-stack target representation)))
         (t
@@ -2735 +1654 @@
   (cond ((and (null representation) (null (cdr form)))
          (emit-push-current-thread)
-         (emit-invokestatic +lisp-class+ "gensym"
+         (emit-invokestatic +lisp+ "gensym"
                             (list +lisp-thread+) +lisp-symbol+)
          (emit-move-from-stack target))
@@ -2756 +1675 @@
               (compile-form arg3 'stack nil)
               (maybe-emit-clear-values arg1 arg2 arg3)))
-       (emit-invokestatic +lisp-class+ "get"
+       (emit-invokestatic +lisp+ "get"
                           (lisp-object-arg-types (if arg3 3 2))
                           +lisp-object+)
@@ -2778 +1697 @@
                 arg2 'stack nil
                 arg3 'stack nil)
-         (emit-invokestatic +lisp-class+ "getf"
+         (emit-invokestatic +lisp+ "getf"
                             (lisp-object-arg-types 3) +lisp-object+)
          (fix-boxing representation nil)
@@ -2793 +1712 @@
                (ht-form (%caddr form)))
            (compile-form ht-form 'stack nil)
-           (emit 'checkcast +lisp-hash-table-class+)
+           (emit-checkcast +lisp-hash-table+)
            (compile-form key-form 'stack nil)
            (maybe-emit-clear-values ht-form key-form)
-           (emit-invokevirtual +lisp-hash-table-class+ "gethash1"
+           (emit-invokevirtual +lisp-hash-table+ "gethash1"
                                (lisp-object-arg-types 1) +lisp-object+)
            (fix-boxing representation nil)
@@ -2811 +1730 @@
                (value-form (fourth form)))
            (compile-form ht-form 'stack nil)
-           (emit 'checkcast +lisp-hash-table-class+)
+           (emit-checkcast +lisp-hash-table+)
            (compile-form key-form 'stack nil)
            (compile-form value-form 'stack nil)
            (maybe-emit-clear-values ht-form key-form value-form)
            (cond (target
-                  (emit-invokevirtual +lisp-hash-table-class+ "puthash"
+                  (emit-invokevirtual +lisp-hash-table+ "puthash"
                                       (lisp-object-arg-types 2) +lisp-object+)
                   (fix-boxing representation nil)
                   (emit-move-from-stack target representation))
                  (t
-                  (emit-invokevirtual +lisp-hash-table-class+ "put"
+                  (emit-invokevirtual +lisp-hash-table+ "put"
                                       (lisp-object-arg-types 2) nil)))))
         (t
@@ -2858 +1777 @@
               (t
                (emit-push-constant-int numargs)
-               (emit 'anewarray +lisp-object-class+)
+               (emit-anewarray +lisp-object+)
                (let ((i 0))
                  (dolist (arg args)
@@ -2891 +1810 @@
                        (list +lisp-object-array+)))
         (return-type +lisp-object+))
-    (emit-invokevirtual +lisp-object-class+ "execute" arg-types return-type)))
+    (emit-invokevirtual +lisp-object+ "execute" arg-types return-type)))
 
 (declaim (ftype (function (t) t) emit-call-thread-execute))
@@ -2899 +1818 @@
                        (list +lisp-object+ +lisp-object-array+)))
         (return-type +lisp-object+))
-    (emit-invokevirtual +lisp-thread-class+ "execute" arg-types return-type)))
+    (emit-invokevirtual +lisp-thread+ "execute" arg-types return-type)))
 
 (defknown compile-function-call (t t t) t)
@@ -3033 +1952 @@
     (emit-push-constant-int 0)                            ;; srcPos
     (emit-push-constant-int (length *closure-variables*))
-    (emit 'anewarray +closure-binding-class+)             ;; dest
+    (emit-anewarray +lisp-closure-binding+)             ;; dest
     (emit 'dup)
     (astore register)  ;; save dest value
     (emit-push-constant-int 0)                            ;; destPos
     (emit-push-constant-int (length *closure-variables*)) ;; length
-    (emit-invokestatic "java/lang/System" "arraycopy"
-                       (list +java-object+ "I"
-                             +java-object+ "I" "I") nil)
+    (emit-invokestatic +java-system+ "arraycopy"
+                       (list +java-object+ :int
+                             +java-object+ :int :int) nil)
     (aload register))) ;; reload dest value
 
@@ -3068 +1987 @@
            (emit-load-externalized-object
             (local-function-environment local-function)
-            +lisp-environment-class+)
+            +lisp-environment+)
            (emit-load-externalized-object (local-function-name local-function))
-           (emit-invokevirtual +lisp-environment-class+ "lookupFunction"
+           (emit-invokevirtual +lisp-environment+ "lookupFunction"
                                (list +lisp-object+)
                                +lisp-object+))
@@ -3082 +2001 @@
                                         ; Stack: template-function
              (when *closure-variables*
-               (emit 'checkcast +lisp-compiled-closure-class+)
+               (emit-checkcast +lisp-compiled-closure+)
                (duplicate-closure-array compiland)
-               (emit-invokestatic +lisp-class+ "makeCompiledClosure"
+               (emit-invokestatic +lisp+ "makeCompiledClosure"
                                   (list +lisp-object+ +closure-binding-array+)
                                   +lisp-object+)))))
@@ -3156 +2075 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
                 (emit-push-constant-int arg2)
-                (emit-invokevirtual +lisp-object-class+
+                (emit-invokevirtual +lisp-object+
                                     (case op
                                       (<  "isLessThan")
@@ -3163 +2082 @@
                                       (>= "isGreaterThanOrEqualTo")
                                       (=  "isEqualTo"))
-                                    '("I")
-                                    "Z")
+                                    '(:int)
+                                    :boolean)
                 ;; Java boolean on stack here
                 (convert-representation :boolean representation)
@@ -3289 +2208 @@
     (let ((arg (%cadr form)))
       (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-      (emit-invokevirtual +lisp-object-class+ java-predicate nil "Z")
+      (emit-invokevirtual +lisp-object+ java-predicate nil :boolean)
       'ifeq)))
 
@@ -3297 +2216 @@
     (let ((arg (%cadr form)))
       (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-      (emit 'instanceof java-class)
+      (emit-instanceof java-class)
       'ifeq)))
 
 (defun p2-test-bit-vector-p (form)
-  (p2-test-instanceof-predicate form +lisp-abstract-bit-vector-class+))
+  (p2-test-instanceof-predicate form +lisp-abstract-bit-vector+))
 
 (defun p2-test-characterp (form)
-  (p2-test-instanceof-predicate form +lisp-character-class+))
+  (p2-test-instanceof-predicate form +lisp-character+))
 
 ;; constantp form &optional environment => generalized-boolean
@@ -3311 +2230 @@
     (let ((arg (%cadr form)))
       (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-      (emit-invokevirtual +lisp-object-class+ "constantp" nil "Z")
+      (emit-invokevirtual +lisp-object+ "constantp" nil :boolean)
       'ifeq)))
 
@@ -3372 +2291 @@
 
 (defun p2-test-packagep (form)
-  (p2-test-instanceof-predicate form +lisp-package-class+))
+  (p2-test-instanceof-predicate form +lisp-package+))
 
 (defun p2-test-rationalp (form)
@@ -3387 +2306 @@
 
 (defun p2-test-symbolp (form)
-  (p2-test-instanceof-predicate form +lisp-symbol-class+))
+  (p2-test-instanceof-predicate form +lisp-symbol+))
 
 (defun p2-test-consp (form)
-  (p2-test-instanceof-predicate form +lisp-cons-class+))
+  (p2-test-instanceof-predicate form +lisp-cons+))
 
 (defun p2-test-atom (form)
-  (p2-test-instanceof-predicate form +lisp-cons-class+)
+  (p2-test-instanceof-predicate form +lisp-cons+)
   'ifne)
 
 (defun p2-test-fixnump (form)
-  (p2-test-instanceof-predicate form +lisp-fixnum-class+))
+  (p2-test-instanceof-predicate form +lisp-fixnum+))
 
 (defun p2-test-stringp (form)
-  (p2-test-instanceof-predicate form +lisp-abstract-string-class+))
+  (p2-test-instanceof-predicate form +lisp-abstract-string+))
 
 (defun p2-test-vectorp (form)
-  (p2-test-instanceof-predicate form +lisp-abstract-vector-class+))
+  (p2-test-instanceof-predicate form +lisp-abstract-vector+))
 
 (defun p2-test-simple-vector-p (form)
-  (p2-test-instanceof-predicate form +lisp-simple-vector-class+))
+  (p2-test-instanceof-predicate form +lisp-simple-vector+))
 
 (defknown compile-test-form (t) t)
@@ -3502 +2421 @@
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
               arg2 'stack :char)
-             (emit-invokevirtual +lisp-object-class+ "eql" '("C") "Z")
+             (emit-invokevirtual +lisp-object+ "eql" '(:char) :boolean)
              'ifeq)
             ((eq type1 'CHARACTER)
@@ -3508 +2427 @@
               arg2 'stack nil)
              (emit 'swap)
-             (emit-invokevirtual +lisp-object-class+ "eql" '("C") "Z")
+             (emit-invokevirtual +lisp-object+ "eql" '(:char) :boolean)
              'ifeq)
             ((fixnum-type-p type2)
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
               arg2 'stack :int)
-             (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
+             (emit-invokevirtual +lisp-object+ "eql" '(:int) :boolean)
              'ifeq)
             ((fixnum-type-p type1)
@@ -3519 +2438 @@
               arg2 'stack nil)
              (emit 'swap)
-             (emit-invokevirtual +lisp-object-class+ "eql" '("I") "Z")
+             (emit-invokevirtual +lisp-object+ "eql" '(:int) :boolean)
              'ifeq)
             (t
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
               arg2 'stack nil)
-             (emit-invokevirtual +lisp-object-class+ "eql"
-                                 (lisp-object-arg-types 1) "Z")
+             (emit-invokevirtual +lisp-object+ "eql"
+                                 (lisp-object-arg-types 1) :boolean)
              'ifeq)))))
 
@@ -3539 +2458 @@
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
               arg2 'stack :int)
-             (emit-invokevirtual +lisp-object-class+
+             (emit-invokevirtual +lisp-object+
                                  translated-op
-                                 '("I") "Z"))
+                                 '(:int) :boolean))
             (t
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
               arg2 'stack nil)
-             (emit-invokevirtual +lisp-object-class+
+             (emit-invokevirtual +lisp-object+
                                  translated-op
-                                 (lisp-object-arg-types 1) "Z")))
+                                 (lisp-object-arg-types 1) :boolean)))
       'ifeq)))
 
@@ -3556 +2475 @@
       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
              arg2 'stack nil)
-      (emit-invokevirtual +lisp-object-class+ "typep"
+      (emit-invokevirtual +lisp-object+ "typep"
                           (lisp-object-arg-types 1) +lisp-object+)
       (emit-push-nil)
@@ -3567 +2486 @@
       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
              arg2 'stack nil)
-      (emit-invokestatic +lisp-class+ "memq"
-                         (lisp-object-arg-types 2) "Z")
+      (emit-invokestatic +lisp+ "memq"
+                         (lisp-object-arg-types 2) :boolean)
       'ifeq)))
 
@@ -3577 +2496 @@
       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
              arg2 'stack nil)
-      (emit-invokestatic +lisp-class+ "memql"
-                         (lisp-object-arg-types 2) "Z")
+      (emit-invokestatic +lisp+ "memql"
+                         (lisp-object-arg-types 2) :boolean)
       'ifeq)))
 
@@ -3597 +2516 @@
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
               arg2 'stack :int)
-             (emit-invokevirtual +lisp-object-class+ "isNotEqualTo" '("I") "Z")
+             (emit-invokevirtual +lisp-object+ "isNotEqualTo" '(:int) :boolean)
              'ifeq)
             ((fixnum-type-p type1)
@@ -3605 +2524 @@
               arg2 'stack nil)
              (emit 'swap)
-             (emit-invokevirtual +lisp-object-class+ "isNotEqualTo" '("I") "Z")
+             (emit-invokevirtual +lisp-object+ "isNotEqualTo" '(:int) :boolean)
              'ifeq)
             (t
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
               arg2 'stack nil)
-             (emit-invokevirtual +lisp-object-class+ "isNotEqualTo"
-                                 (lisp-object-arg-types 1) "Z")
+             (emit-invokevirtual +lisp-object+ "isNotEqualTo"
+                                 (lisp-object-arg-types 1) :boolean)
              'ifeq)))))
 
@@ -3647 +2566 @@
          (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                 arg2 'stack :int)
-               (emit-invokevirtual +lisp-object-class+
+               (emit-invokevirtual +lisp-object+
                                    (ecase op
                                      (<  "isLessThan")
@@ -3654 +2573 @@
                                      (>= "isGreaterThanOrEqualTo")
                                      (=  "isEqualTo"))
-                                   '("I") "Z")
+                                   '(:int) :boolean)
                'ifeq)
               ((fixnum-type-p type1)
@@ -3662 +2581 @@
                 arg2 'stack nil)
                (emit 'swap)
-               (emit-invokevirtual +lisp-object-class+
+               (emit-invokevirtual +lisp-object+
                                    (ecase op
                                      (<  "isGreaterThan")
@@ -3669 +2588 @@
                                      (>= "isLessThanOrEqualTo")
                                      (=  "isEqualTo"))
-                                   '("I") "Z")
+                                   '(:int) :boolean)
                'ifeq)
               (t
          (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                 arg2 'stack nil)
-               (emit-invokevirtual +lisp-object-class+
+               (emit-invokevirtual +lisp-object+
                                    (ecase op
                                      (<  "isLessThan")
@@ -3681 +2600 @@
                                      (>= "isGreaterThanOrEqualTo")
                                      (=  "isEqualTo"))
-                                   (lisp-object-arg-types 1) "Z")
+                                   (lisp-object-arg-types 1) :boolean)
                'ifeq))))))
 
@@ -3817 +2736 @@
   (emit-clear-values)
   (compile-form (second form) 'stack nil)
-  (emit-invokestatic +lisp-class+ "multipleValueList"
+  (emit-invokestatic +lisp+ "multipleValueList"
                      (lisp-object-arg-types 1) +lisp-object+)
   (fix-boxing representation nil)
@@ -3832 +2751 @@
     ;; Save multiple values returned by first subform.
     (emit-push-current-thread)
-    (emit 'getfield +lisp-thread-class+ "_values" +lisp-object-array+)
+    (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
     (astore values-register)
     (dolist (subform subforms)
@@ -3839 +2758 @@
     (emit-push-current-thread)
     (aload values-register)
-    (emit 'putfield +lisp-thread-class+ "_values" +lisp-object-array+)
+    (emit-putfield +lisp-thread+ "_values" +lisp-object-array+)
     ;; Result.
     (aload result-register)
@@ -3853 +2772 @@
     (2
      (compile-form (second form) 'stack nil)
-     (emit-invokestatic +lisp-class+ "coerceToFunction"
+     (emit-invokestatic +lisp+ "coerceToFunction"
                         (lisp-object-arg-types 1) +lisp-object+)
-     (emit-invokevirtual +lisp-object-class+ "execute" nil +lisp-object+))
+     (emit-invokevirtual +lisp-object+ "execute" nil +lisp-object+))
     (3
      (let* ((*register* *register*)
@@ -3863 +2782 @@
        (aload function-register)
        (emit-push-current-thread)
-       (emit-invokestatic +lisp-class+ "multipleValueCall1"
+       (emit-invokestatic +lisp+ "multipleValueCall1"
                           (list +lisp-object+ +lisp-object+ +lisp-thread+)
                           +lisp-object+)))
@@ -3872 +2791 @@
             (values-register (allocate-register)))
        (compile-form (second form) 'stack nil)
-       (emit-invokestatic +lisp-class+ "coerceToFunction"
+       (emit-invokestatic +lisp+ "coerceToFunction"
                           (lisp-object-arg-types 1) +lisp-object+)
        (emit-move-from-stack function-register)
@@ -3882 +2801 @@
          (emit 'swap)
          (aload values-register)
-         (emit-invokevirtual +lisp-thread-class+ "accumulateValues"
+         (emit-invokevirtual +lisp-thread+ "accumulateValues"
                              (list +lisp-object+ +lisp-object-array+)
                              +lisp-object-array+)
@@ -3889 +2808 @@
        (aload function-register)
        (aload values-register)
-       (emit-invokevirtual +lisp-object-class+ "dispatch"
+       (emit-invokevirtual +lisp-object+ "dispatch"
                            (list +lisp-object-array+) +lisp-object+))))
   (fix-boxing representation nil)
@@ -3912 +2831 @@
 (defun emit-new-closure-binding (variable)
   ""
-  (emit 'new +closure-binding-class+)            ;; value c-b
+  (emit-new +lisp-closure-binding+)            ;; value c-b
   (emit 'dup_x1)                                 ;; c-b value c-b
   (emit 'swap)                                   ;; c-b c-b value
-  (emit-invokespecial-init +closure-binding-class+
+  (emit-invokespecial-init +lisp-closure-binding+
                            (list +lisp-object+)) ;; c-b
   (aload (compiland-closure-register *current-compiland*))
@@ -3935 +2854 @@
          (emit-push-variable-name variable)
          (emit 'swap)
-         (emit-invokevirtual +lisp-thread-class+ "bindSpecial"
+         (emit-invokevirtual +lisp-thread+ "bindSpecial"
                              (list +lisp-symbol+ +lisp-object+)
                              +lisp-special-binding+)
@@ -3976 +2895 @@
    (emit-push-current-thread)
    (aload register)
-   (emit-invokevirtual +lisp-thread-class+ "resetSpecialBindings"
+   (emit-invokevirtual +lisp-thread+ "resetSpecialBindings"
                        (list +lisp-special-bindings-mark+) nil)
   )
@@ -3982 +2901 @@
 (defun save-dynamic-environment (register)
    (emit-push-current-thread)
-   (emit-invokevirtual +lisp-thread-class+ "markSpecialBindings"
+   (emit-invokevirtual +lisp-thread+ "markSpecialBindings"
                        nil +lisp-special-bindings-mark+)
    (astore register)
@@ -3997 +2916 @@
     (label label-EXIT)
     (restore-dynamic-environment register)
-    (push (make-handler :from label-START
-      :to label-END
-      :code label-END
-      :catch-type 0) *handlers*)))
+    (add-exception-handler label-START label-END label-END nil)))
 
 (defun p2-m-v-b-node (block target)
@@ -4041 +2957 @@
              ;; Store values from values form in values register.
              (emit-push-current-thread)
-             (emit 'getfield +lisp-thread-class+ "_values" +lisp-object-array+)
+             (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
              (emit-move-from-stack values-register)
              ;; Did we get just one value?
@@ -4060 +2976 @@
              (aload result-register)
              (emit-push-constant-int (length vars))
-             (emit-invokevirtual +lisp-thread-class+ "getValues"
-                                 (list +lisp-object+ "I") +lisp-object-array+)
+             (emit-invokevirtual +lisp-thread+ "getValues"
+                                 (list +lisp-object+ :int) +lisp-object-array+)
              ;; Values array is now on the stack at runtime.
              (label LABEL2)
@@ -4216 +3132 @@
            (emit 'aaload)
            (emit-swap representation nil)
-           (emit 'putfield +closure-binding-class+ "value" +lisp-object+))
+           (emit-putfield +lisp-closure-binding+ "value" +lisp-object+))
           ((variable-environment variable)
            (assert (not *file-compilation*))
            (emit-load-externalized-object (variable-environment variable)
-                                          +lisp-environment-class+)
+                                          +lisp-environment+)
            (emit 'swap)
            (emit-push-variable-name variable)
            (emit 'swap)
-           (emit-invokevirtual +lisp-environment-class+ "rebind"
+           (emit-invokevirtual +lisp-environment+ "rebind"
                                (list +lisp-symbol+ +lisp-object+)
                                nil))
@@ -4248 +3164 @@
          (emit-push-constant-int (variable-closure-index variable))
          (emit 'aaload)
-         (emit 'getfield +closure-binding-class+ "value" +lisp-object+))
+         (emit-getfield +lisp-closure-binding+ "value" +lisp-object+))
         ((variable-environment variable)
          (assert (not *file-compilation*))
          (emit-load-externalized-object (variable-environment variable)
-                                        +lisp-environment-class+)
+                                        +lisp-environment+)
          (emit-push-variable-name variable)
-         (emit-invokevirtual +lisp-environment-class+ "lookup"
+         (emit-invokevirtual +lisp-environment+ "lookup"
                              (list +lisp-object+)
                              +lisp-object+))
@@ -4347 +3263 @@
                  (emit-push-current-thread)
                  (emit-push-variable-name variable)
-                 (emit-invokevirtual +lisp-thread-class+
+                 (emit-invokevirtual +lisp-thread+
                                      "bindSpecialToCurrentValue"
                                      (list +lisp-symbol+)
@@ -4473 +3389 @@
       ;; we have a block variable; that should be a closure variable
       (assert (not (null (variable-closure-index (tagbody-id-variable block)))))
-      (emit 'new +lisp-object-class+)
+      (emit-new +lisp-object+)
       (emit 'dup)
-      (emit-invokespecial-init +lisp-object-class+ '())
+      (emit-invokespecial-init +lisp-object+ '())
       (emit-new-closure-binding (tagbody-id-variable block)))
     (label BEGIN-BLOCK)
@@ -4507 +3423 @@
         (astore go-register)
         ;; Get the tag.
-        (emit 'getfield +lisp-go-class+ "tagbody" +lisp-object+) ; Stack depth is still 1.
+        (emit-getfield +lisp-go+ "tagbody" +lisp-object+) ; Stack depth is still 1.
         (emit-push-variable (tagbody-id-variable block))
         (emit 'if_acmpne RETHROW) ;; Not this TAGBODY
         (aload go-register)
-        (emit 'getfield +lisp-go-class+ "tag" +lisp-object+) ; Stack depth is still 1.
+        (emit-getfield +lisp-go+ "tag" +lisp-object+) ; Stack depth is still 1.
         (astore tag-register)
         ;; Don't actually generate comparisons for tags
@@ -4532 +3448 @@
         (emit 'athrow)
         ;; Finally...
-        (push (make-handler :from BEGIN-BLOCK
-                            :to END-BLOCK
-                            :code HANDLER
-                            :catch-type (pool-class +lisp-go-class+))
-              *handlers*)
-        (push (make-handler :from BEGIN-BLOCK
-                            :to END-BLOCK
-                            :code EXTENT-EXIT-HANDLER
-                            :catch-type 0)
-              *handlers*)))
+        (add-exception-handler BEGIN-BLOCK END-BLOCK HANDLER +lisp-go+)
+        (add-exception-handler BEGIN-BLOCK END-BLOCK EXTENT-EXIT-HANDLER nil)))
     (label EXIT)
     (when (tagbody-non-local-go-p block)
@@ -4577 +3485 @@
     (emit-push-variable (tagbody-id-variable tag-block))
     (emit-load-externalized-object (tag-label tag)) ; Tag.
-    (emit-invokestatic +lisp-class+ "nonLocalGo" (lisp-object-arg-types 2)
+    (emit-invokestatic +lisp+ "nonLocalGo" (lisp-object-arg-types 2)
                        +lisp-object+)
     ;; Following code will not be reached, but is needed for JVM stack
@@ -4588 +3496 @@
    (check-arg-count form 1))
   (compile-forms-and-maybe-emit-clear-values (cadr form) 'stack nil)
-  (emit 'instanceof +lisp-cons-class+)
+  (emit-instanceof +lisp-cons+)
   (let ((LABEL1 (gensym))
         (LABEL2 (gensym)))
@@ -4617 +3525 @@
           (t
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-           (emit 'instanceof java-class)
+           (emit-instanceof java-class)
            (convert-representation :boolean representation)
            (emit-move-from-stack target representation)))))
 
 (defun p2-bit-vector-p (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-abstract-bit-vector-class+))
+  (p2-instanceof-predicate form target representation +lisp-abstract-bit-vector+))
 
 (defun p2-characterp (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-character-class+))
+  (p2-instanceof-predicate form target representation +lisp-character+))
 
 (defun p2-consp (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-cons-class+))
+  (p2-instanceof-predicate form target representation +lisp-cons+))
 
 (defun p2-fixnump (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-fixnum-class+))
+  (p2-instanceof-predicate form target representation +lisp-fixnum+))
 
 (defun p2-packagep (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-package-class+))
+  (p2-instanceof-predicate form target representation +lisp-package+))
 
 (defun p2-readtablep (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-readtable-class+))
+  (p2-instanceof-predicate form target representation +lisp-readtable+))
 
 (defun p2-simple-vector-p (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-simple-vector-class+))
+  (p2-instanceof-predicate form target representation +lisp-simple-vector+))
 
 (defun p2-stringp (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-abstract-string-class+))
+  (p2-instanceof-predicate form target representation +lisp-abstract-string+))
 
 (defun p2-symbolp (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-symbol-class+))
+  (p2-instanceof-predicate form target representation +lisp-symbol+))
 
 (defun p2-vectorp (form target representation)
-  (p2-instanceof-predicate form target representation +lisp-abstract-vector-class+))
+  (p2-instanceof-predicate form target representation +lisp-abstract-vector+))
 
 (define-inlined-function p2-coerce-to-function (form target representation)
   ((check-arg-count form 1))
   (compile-forms-and-maybe-emit-clear-values (%cadr form) 'stack nil)
-  (emit-invokestatic +lisp-class+ "coerceToFunction"
+  (emit-invokestatic +lisp+ "coerceToFunction"
                      (lisp-object-arg-types 1) +lisp-object+)
   (emit-move-from-stack target))
@@ -4671 +3579 @@
       ;; we have a block variable; that should be a closure variable
       (assert (not (null (variable-closure-index (block-id-variable block)))))
-      (emit 'new +lisp-object-class+)
+      (emit-new +lisp-object+)
       (emit 'dup)
-      (emit-invokespecial-init +lisp-object-class+ '())
+      (emit-invokespecial-init +lisp-object+ '())
       (emit-new-closure-binding (block-id-variable block)))
     (dformat t "*all-variables* = ~S~%"
@@ -4690 +3598 @@
         ;; The Return object is on the runtime stack. Stack depth is 1.
         (emit 'dup) ; Stack depth is 2.
-        (emit 'getfield +lisp-return-class+ "tag" +lisp-object+) ; Still 2.
+        (emit-getfield +lisp-return+ "tag" +lisp-object+) ; Still 2.
         (emit-push-variable (block-id-variable block))
         ;; If it's not the block we're looking for...
@@ -4700 +3608 @@
         (emit 'athrow)
         (label THIS-BLOCK)
-        (emit 'getfield +lisp-return-class+ "result" +lisp-object+)
+        (emit-getfield +lisp-return+ "result" +lisp-object+)
         (emit-move-from-stack target) ; Stack depth is 0.
         ;; Finally...
-        (push (make-handler :from BEGIN-BLOCK
-                            :to END-BLOCK
-                            :code HANDLER
-                            :catch-type (pool-class +lisp-return-class+))
-              *handlers*)
-        (push (make-handler :from BEGIN-BLOCK
-                            :to END-BLOCK
-                            :code EXTENT-EXIT-HANDLER
-                            :catch-type 0)
-              *handlers*)))
+        (add-exception-handler BEGIN-BLOCK END-BLOCK HANDLER +lisp-return+)
+        (add-exception-handler BEGIN-BLOCK END-BLOCK EXTENT-EXIT-HANDLER nil)))
     (label BLOCK-EXIT)
     (when (block-id-variable block)
@@ -4747 +3647 @@
     (emit-clear-values)
     (compile-form result-form 'stack nil)
-    (emit-invokestatic +lisp-class+ "nonLocalReturn" (lisp-object-arg-types 3)
+    (emit-invokestatic +lisp+ "nonLocalReturn" (lisp-object-arg-types 3)
                        +lisp-object+)
     ;; Following code will not be reached, but is needed for JVM stack
@@ -4775 +3675 @@
 (define-inlined-function p2-cons (form target representation)
   ((check-arg-count form 2))
-  (emit 'new +lisp-cons-class+)
+  (emit-new +lisp-cons+)
   (emit 'dup)
   (let* ((args (%cdr form))
@@ -4782 +3682 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack nil))
-  (emit-invokespecial-init +lisp-cons-class+ (lisp-object-arg-types 2))
+  (emit-invokespecial-init +lisp-cons+ (lisp-object-arg-types 2))
   (emit-move-from-stack target))
 
@@ -4824 +3724 @@
     ;; Compile call to Lisp.progvBindVars().
     (emit-push-current-thread)
-    (emit-invokestatic +lisp-class+ "progvBindVars"
+    (emit-invokestatic +lisp+ "progvBindVars"
                        (list +lisp-object+ +lisp-object+ +lisp-thread+) nil)
       ;; Implicit PROGN.
@@ -4859 +3759 @@
       (emit 'dup))
     (compile-form (second args) 'stack nil)
-    (emit-invokevirtual +lisp-object-class+
+    (emit-invokevirtual +lisp-object+
                         "setCdr"
                         (lisp-object-arg-types 1)
@@ -4875 +3775 @@
     (when target
       (emit-dup nil :past nil))
-    (emit-invokevirtual +lisp-object-class+
+    (emit-invokevirtual +lisp-object+
                         (if (eq op 'sys:set-car) "setCar" "setCdr")
                         (lisp-object-arg-types 1)
@@ -4889 +3789 @@
     (emit-move-from-stack target)))
 
-(defun compile-and-write-to-stream (class-file compiland stream)
-  (with-class-file class-file
-    (let ((*current-compiland* compiland))
-      (with-saved-compiler-policy
-    (p2-compiland compiland)
-  (write-class-file (compiland-class-file compiland) stream)))))
-
-(defun set-compiland-and-write-class (class-file compiland stream)
-  (setf (compiland-class-file compiland) class-file)
-  (compile-and-write-to-stream class-file compiland stream))
-
-
-(defmacro with-temp-class-file (pathname class-file lambda-list &body body)
-  `(let* ((,pathname (make-temp-file))
-    (,class-file (make-class-file :pathname ,pathname
-               :lambda-list ,lambda-list)))
-     (unwind-protect
-    (progn ,@body)
-       (delete-file pathname))))
+(defun compile-and-write-to-stream (compiland &optional stream)
+  "Creates a class file associated with `compiland`, writing it
+either to stream or the pathname of the class file if `stream' is NIL."
+  (let* ((pathname (funcall *pathnames-generator*))
+         (class-file (make-abcl-class-file
+                      :pathname pathname
+                      :lambda-list
+                      (cadr (compiland-lambda-expression compiland)))))
+    (setf (compiland-class-file compiland) class-file)
+    (with-open-stream (f (or stream
+                             (open pathname :direction :output
+                                   :element-type '(unsigned-byte 8)
+                                   :if-exists :supersede)))
+      (with-class-file class-file
+        (let ((*current-compiland* compiland))
+          (with-saved-compiler-policy
+              (p2-compiland compiland)
+            ;;        (finalize-class-file (compiland-class-file compiland))
+            (finish-class (compiland-class-file compiland) f)))))))
 
 (defknown p2-flet-process-compiland (t) t)
 (defun p2-flet-process-compiland (local-function)
-  (let* ((compiland (local-function-compiland local-function))
-         (lambda-list (cadr (compiland-lambda-expression compiland))))
+  (let* ((compiland (local-function-compiland local-function)))
     (cond (*file-compilation*
-           (let* ((pathname (funcall *pathnames-generator*))
-                  (class-file (make-class-file :pathname pathname
-                                               :lambda-list lambda-list)))
-             (with-open-class-file (f class-file)
-               (set-compiland-and-write-class class-file compiland f))
-             (setf (local-function-class-file local-function) class-file)))
+           (compile-and-write-to-stream compiland)
+           (setf (local-function-class-file local-function)
+                 (compiland-class-file compiland)))
           (t
-           (let ((class-file (make-class-file :lambda-list lambda-list)))
-             (with-open-stream (stream (sys::%make-byte-array-output-stream))
-               (set-compiland-and-write-class class-file compiland stream)
-               (setf (local-function-class-file local-function) class-file)
-               (setf (local-function-function local-function)
-                     (load-compiled-function
-                      (sys::%get-output-stream-bytes stream)))))))))
+           (with-open-stream (stream (sys::%make-byte-array-output-stream))
+             (compile-and-write-to-stream compiland stream)
+             (setf (local-function-class-file local-function)
+                   (compiland-class-file compiland))
+             (setf (local-function-function local-function)
+                   (load-compiled-function
+                    (sys::%get-output-stream-bytes stream))))))))
 
 (defun emit-make-compiled-closure-for-labels
@@ -4936 +3832 @@
       (dformat t "(compiland-closure-register parent) = ~S~%"
          (compiland-closure-register parent))
-      (emit 'checkcast +lisp-compiled-closure-class+)
+      (emit-checkcast +lisp-compiled-closure+)
       (duplicate-closure-array parent)
-      (emit-invokestatic +lisp-class+ "makeCompiledClosure"
+      (emit-invokestatic +lisp+ "makeCompiledClosure"
        (list +lisp-object+ +closure-binding-array+)
        +lisp-object+)))
@@ -4945 +3841 @@
 (defknown p2-labels-process-compiland (t) t)
 (defun p2-labels-process-compiland (local-function)
-  (let* ((compiland (local-function-compiland local-function))
-         (lambda-list (cadr (compiland-lambda-expression compiland))))
+  (let* ((compiland (local-function-compiland local-function)))
     (cond (*file-compilation*
-           (let* ((pathname (funcall *pathnames-generator*))
-                  (class-file (make-class-file :pathname pathname
-                                               :lambda-list lambda-list)))
-             (with-open-class-file (f class-file)
-               (set-compiland-and-write-class class-file compiland f))
-             (setf (local-function-class-file local-function) class-file)
-             (let ((g (declare-local-function local-function)))
+           (compile-and-write-to-stream compiland)
+           (setf (local-function-class-file local-function)
+                 (compiland-class-file compiland))
+           (let ((g (declare-local-function local-function)))
+             (emit-make-compiled-closure-for-labels
+              local-function compiland g)))
+          (t
+           (with-open-stream (stream (sys::%make-byte-array-output-stream))
+             (compile-and-write-to-stream compiland stream)
+             (setf (local-function-class-file local-function)
+                   (compiland-class-file compiland))
+             (let ((g (declare-object
+                       (load-compiled-function
+                        (sys::%get-output-stream-bytes stream)))))
                (emit-make-compiled-closure-for-labels
-                local-function compiland g))))
-          (t
-           (let ((class-file (make-class-file :lambda-list lambda-list)))
-             (with-open-stream (stream (sys::%make-byte-array-output-stream))
-               (set-compiland-and-write-class class-file compiland stream)
-               (setf (local-function-class-file local-function) class-file)
-               (let ((g (declare-object
-                         (load-compiled-function
-                          (sys::%get-output-stream-bytes stream)))))
-                 (emit-make-compiled-closure-for-labels
-                  local-function compiland g))))))))
+                local-function compiland g)))))))
 
 (defknown p2-flet-node (t t t) t)
@@ -5007 +3899 @@
 
 (defun p2-lambda (compiland target)
-  (let* ((lambda-list (cadr (compiland-lambda-expression compiland))))
-    (aver (null (compiland-class-file compiland)))
-    (cond (*file-compilation*
-           (setf (compiland-class-file compiland)
-                 (make-class-file :pathname (funcall *pathnames-generator*)
-                                  :lambda-list lambda-list))
-           (let ((class-file (compiland-class-file compiland)))
-       (with-open-class-file (f class-file)
-         (compile-and-write-to-stream class-file compiland f))
-             (emit-getstatic *this-class*
-                   (declare-local-function (make-local-function :class-file
-                                                                class-file))
-                   +lisp-object+)))
-          (t
-           (setf (compiland-class-file compiland)
-                 (make-class-file :lambda-list lambda-list))
-           (with-open-stream (stream (sys::%make-byte-array-output-stream))
-             (compile-and-write-to-stream (compiland-class-file compiland)
-                                          compiland stream)
-             (emit-load-externalized-object (load-compiled-function
-                                    (sys::%get-output-stream-bytes stream))))))
-    (cond ((null *closure-variables*))  ; Nothing to do.
-          ((compiland-closure-register *current-compiland*)
-           (duplicate-closure-array *current-compiland*)
-           (emit-invokestatic +lisp-class+ "makeCompiledClosure"
-                              (list +lisp-object+ +closure-binding-array+)
-                              +lisp-object+))
+  (aver (null (compiland-class-file compiland)))
+  (cond (*file-compilation*
+         (compile-and-write-to-stream compiland)
+         (emit-getstatic *this-class*
+                         (declare-local-function
+                          (make-local-function
+                           :class-file (compiland-class-file compiland)))
+                         +lisp-object+))
+        (t
+         (with-open-stream (stream (sys::%make-byte-array-output-stream))
+           (compile-and-write-to-stream compiland stream)
+           (emit-load-externalized-object (load-compiled-function
+                                           (sys::%get-output-stream-bytes stream))))))
+  (cond ((null *closure-variables*))    ; Nothing to do.
+        ((compiland-closure-register *current-compiland*)
+         (duplicate-closure-array *current-compiland*)
+         (emit-invokestatic +lisp+ "makeCompiledClosure"
+                            (list +lisp-object+ +closure-binding-array+)
+                            +lisp-object+))
                                         ; Stack: compiled-closure
-          (t
-           (aver nil))) ;; Shouldn't happen.
-    (emit-move-from-stack target)))
+        (t
+         (aver nil))) ;; Shouldn't happen.
+
+  (emit-move-from-stack target))
 
 (defknown p2-function (t t t) t)
@@ -5066 +3951 @@
 
                (when (compiland-closure-register *current-compiland*)
-                 (emit 'checkcast +lisp-compiled-closure-class+)
+                 (emit-checkcast +lisp-compiled-closure+)
                  (duplicate-closure-array *current-compiland*)
-                 (emit-invokestatic +lisp-class+ "makeCompiledClosure"
+                 (emit-invokestatic +lisp+ "makeCompiledClosure"
                                     (list +lisp-object+ +closure-binding-array+)
                                     +lisp-object+)))))
@@ -5078 +3963 @@
          (t
           (emit-load-externalized-object name)
-          (emit-invokevirtual +lisp-object-class+ "getSymbolFunctionOrDie"
+          (emit-invokevirtual +lisp-object+ "getSymbolFunctionOrDie"
                               nil +lisp-object+)
           (emit-move-from-stack target))))
@@ -5117 +4002 @@
          (t
           (emit-load-externalized-object (cadr name))
-          (emit-invokevirtual +lisp-symbol-class+
+          (emit-invokevirtual +lisp-symbol+
                               "getSymbolSetfFunctionOrDie"
                               nil +lisp-object+)
@@ -5212 +4097 @@
       (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                    arg2 'stack :int)
-                  (emit-invokevirtual +lisp-object-class+ "ash" '("I") +lisp-object+)
+                  (emit-invokevirtual +lisp-object+ "ash" '(:int) +lisp-object+)
                   (fix-boxing representation result-type)))
            (emit-move-from-stack target representation))
@@ -5276 +4161 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack :int)
-                (emit-invokevirtual +lisp-object-class+ "LOGAND" '("I") +lisp-object+)
+                (emit-invokevirtual +lisp-object+ "LOGAND" '(:int) +lisp-object+)
                 (fix-boxing representation result-type)
                 (emit-move-from-stack target representation))
@@ -5285 +4170 @@
                 ;; swap args
                 (emit 'swap)
-                (emit-invokevirtual +lisp-object-class+ "LOGAND" '("I") +lisp-object+)
+                (emit-invokevirtual +lisp-object+ "LOGAND" '(:int) +lisp-object+)
                 (fix-boxing representation result-type)
                 (emit-move-from-stack target representation))
@@ -5291 +4176 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack nil)
-                (emit-invokevirtual +lisp-object-class+ "LOGAND"
+                (emit-invokevirtual +lisp-object+ "LOGAND"
                                     (lisp-object-arg-types 1) +lisp-object+)
                 (fix-boxing representation result-type)
@@ -5348 +4233 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack :int)
-                (emit-invokevirtual +lisp-object-class+ "LOGIOR" '("I") +lisp-object+)
+                (emit-invokevirtual +lisp-object+ "LOGIOR" '(:int) +lisp-object+)
                 (fix-boxing representation result-type)
                 (emit-move-from-stack target representation))
@@ -5357 +4242 @@
                 ;; swap args
                 (emit 'swap)
-                (emit-invokevirtual +lisp-object-class+ "LOGIOR" '("I") +lisp-object+)
+                (emit-invokevirtual +lisp-object+ "LOGIOR" '(:int) +lisp-object+)
                 (fix-boxing representation result-type)
                 (emit-move-from-stack target representation))
@@ -5363 +4248 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack nil)
-                (emit-invokevirtual +lisp-object-class+ "LOGIOR"
+                (emit-invokevirtual +lisp-object+ "LOGIOR"
                                     (lisp-object-arg-types 1) +lisp-object+)
                 (fix-boxing representation result-type)
@@ -5412 +4297 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack :int)
-                (emit-invokevirtual +lisp-object-class+ "LOGXOR" '("I") +lisp-object+)
+                (emit-invokevirtual +lisp-object+ "LOGXOR" '(:int) +lisp-object+)
                 (fix-boxing representation result-type))
                (t
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack nil)
-                (emit-invokevirtual +lisp-object-class+ "LOGXOR"
+                (emit-invokevirtual +lisp-object+ "LOGXOR"
                                     (lisp-object-arg-types 1) +lisp-object+)
                 (fix-boxing representation result-type)))
@@ -5439 +4324 @@
          (let ((arg (%cadr form)))
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil))
-         (emit-invokevirtual +lisp-object-class+ "LOGNOT" nil +lisp-object+)
+         (emit-invokevirtual +lisp-object+ "LOGNOT" nil +lisp-object+)
          (fix-boxing representation nil)
          (emit-move-from-stack target representation))))
@@ -5496 +4381 @@
                   (emit-push-constant-int size)
                   (emit-push-constant-int position)
-                  (emit-invokevirtual +lisp-object-class+ "LDB" '("I" "I") +lisp-object+)
+                  (emit-invokevirtual +lisp-object+ "LDB" '(:int :int) +lisp-object+)
                   (fix-boxing representation nil)
                   (emit-move-from-stack target representation))))
@@ -5506 +4391 @@
            (emit 'dup_x2) ;; use not supported by emit-dup: 3 values involved
            (emit 'pop)
-           (emit-invokevirtual +lisp-object-class+ "LDB" '("I" "I") +lisp-object+)
+           (emit-invokevirtual +lisp-object+ "LDB" '(:int :int) +lisp-object+)
            (fix-boxing representation nil)
            (emit-move-from-stack target representation))
@@ -5525 +4410 @@
      (compile-forms-and-maybe-emit-clear-values arg1 'stack :int
                   arg2 'stack :int)
-           (emit-invokestatic +lisp-class+ "mod" '("I" "I") "I")
+           (emit-invokestatic +lisp+ "mod" '(:int :int) :int)
            (emit-move-from-stack target representation))
           ((fixnum-type-p type2)
      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                   arg2 'stack :int)
-           (emit-invokevirtual +lisp-object-class+ "MOD" '("I") +lisp-object+)
+           (emit-invokevirtual +lisp-object+ "MOD" '(:int) +lisp-object+)
            (fix-boxing representation nil) ; FIXME use derived result type
            (emit-move-from-stack target representation))
@@ -5536 +4421 @@
      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                   arg2 'stack nil)
-           (emit-invokevirtual +lisp-object-class+ "MOD"
+           (emit-invokevirtual +lisp-object+ "MOD"
                                (lisp-object-arg-types 1) +lisp-object+)
            (fix-boxing representation nil) ; FIXME use derived result type
@@ -5604 +4489 @@
        (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
        (emit-push-constant-int 1) ; errorp
-       (emit-invokestatic +lisp-class-class+ "findClass"
-                          (list +lisp-object+ "Z") +lisp-object+)
+       (emit-invokestatic +lisp-class+ "findClass"
+                          (list +lisp-object+ :boolean) +lisp-object+)
        (fix-boxing representation nil)
        (emit-move-from-stack target representation))
@@ -5612 +4497 @@
    (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                 arg2 'stack :boolean)
-         (emit-invokestatic +lisp-class-class+ "findClass"
-                            (list +lisp-object+ "Z") +lisp-object+)
+         (emit-invokestatic +lisp-class+ "findClass"
+                            (list +lisp-object+ :boolean) +lisp-object+)
          (fix-boxing representation nil)
          (emit-move-from-stack target representation)))
@@ -5631 +4516 @@
        (emit 'swap)
        (cond (target
-              (emit-invokevirtual +lisp-object-class+ "VECTOR_PUSH_EXTEND"
+              (emit-invokevirtual +lisp-object+ "VECTOR_PUSH_EXTEND"
                                   (lisp-object-arg-types 1) +lisp-object+)
               (fix-boxing representation nil)
               (emit-move-from-stack target representation))
              (t
-              (emit-invokevirtual +lisp-object-class+ "vectorPushExtend"
+              (emit-invokevirtual +lisp-object+ "vectorPushExtend"
                                   (lisp-object-arg-types 1) nil))))
       (t
@@ -5649 +4534 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack nil)
-    (emit-invokevirtual +lisp-object-class+ "SLOT_VALUE"
+    (emit-invokevirtual +lisp-object+ "SLOT_VALUE"
                         (lisp-object-arg-types 1) +lisp-object+)
     (fix-boxing representation nil)
@@ -5670 +4555 @@
       (emit 'dup)
       (astore value-register))
-    (emit-invokevirtual +lisp-object-class+ "setSlotValue"
+    (emit-invokevirtual +lisp-object+ "setSlotValue"
                         (lisp-object-arg-types 2) nil)
     (when value-register
@@ -5685 +4570 @@
               (null representation))
          (let ((arg (second form)))
-           (emit 'new +lisp-simple-vector-class+)
+           (emit-new +lisp-simple-vector+)
            (emit 'dup)
      (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
-           (emit-invokespecial-init +lisp-simple-vector-class+ '("I"))
+           (emit-invokespecial-init +lisp-simple-vector+ '(:int))
            (emit-move-from-stack target representation)))
         (t
@@ -5710 +4595 @@
               (case result-type
                 ((STRING SIMPLE-STRING)
-                 (setf class +lisp-simple-string-class+))
+                 (setf class +lisp-simple-string+))
                 ((VECTOR SIMPLE-VECTOR)
-                 (setf class +lisp-simple-vector-class+)))))
+                 (setf class +lisp-simple-vector+)))))
         (when class
-          (emit 'new class)
+          (emit-new class)
           (emit 'dup)
     (compile-forms-and-maybe-emit-clear-values arg2 'stack :int)
-          (emit-invokespecial-init class '("I"))
+          (emit-invokespecial-init class '(:int))
           (emit-move-from-stack target representation)
           (return-from p2-make-sequence)))))
@@ -5729 +4614 @@
               (null representation))
          (let ((arg (second form)))
-           (emit 'new +lisp-simple-string-class+)
+           (emit-new +lisp-simple-string+)
            (emit 'dup)
      (compile-forms-and-maybe-emit-clear-values arg 'stack :int)
-           (emit-invokespecial-init +lisp-simple-string-class+ '("I"))
+           (emit-invokespecial-init +lisp-simple-string+ '(:int))
            (emit-move-from-stack target representation)))
         (t
@@ -5740 +4625 @@
   (cond ((and (check-arg-count form 2)
               (eq (derive-type (%cadr form)) 'SYMBOL))
-         (emit 'new +lisp-structure-object-class+)
+         (emit-new +lisp-structure-object+)
          (emit 'dup)
          (compile-form (%cadr form) 'stack nil)
-         (emit 'checkcast +lisp-symbol-class+)
+         (emit-checkcast +lisp-symbol+)
          (compile-form (%caddr form) 'stack nil)
          (maybe-emit-clear-values (%cadr form) (%caddr form))
-         (emit-invokevirtual +lisp-object-class+ "copyToArray"
+         (emit-invokevirtual +lisp-object+ "copyToArray"
                              nil +lisp-object-array+)
-         (emit-invokespecial-init +lisp-structure-object-class+
+         (emit-invokespecial-init +lisp-structure-object+
                                   (list +lisp-symbol+ +lisp-object-array+))
          (emit-move-from-stack target representation))
@@ -5760 +4645 @@
     (cond ((and (<= 1 slot-count 6)
                 (eq (derive-type (%car args)) 'SYMBOL))
-           (emit 'new +lisp-structure-object-class+)
+           (emit-new +lisp-structure-object+)
            (emit 'dup)
            (compile-form (%car args) 'stack nil)
-           (emit 'checkcast +lisp-symbol-class+)
+           (emit-checkcast +lisp-symbol+)
            (dolist (slot-form slot-forms)
              (compile-form slot-form 'stack nil))
            (apply 'maybe-emit-clear-values args)
-           (emit-invokespecial-init +lisp-structure-object-class+
+           (emit-invokespecial-init +lisp-structure-object+
                                     (append (list +lisp-symbol+)
                                             (make-list slot-count :initial-element +lisp-object+)))
@@ -5776 +4661 @@
 (defun p2-make-hash-table (form target representation)
   (cond ((= (length form) 1) ; no args
-         (emit 'new +lisp-eql-hash-table-class+)
+         (emit-new +lisp-eql-hash-table+)
          (emit 'dup)
-         (emit-invokespecial-init +lisp-eql-hash-table-class+ nil)
+         (emit-invokespecial-init +lisp-eql-hash-table+ nil)
          (fix-boxing representation nil)
          (emit-move-from-stack target representation))
@@ -5790 +4675 @@
     (cond ((eq (derive-compiler-type arg) 'STREAM)
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-           (emit 'checkcast +lisp-stream-class+)
-           (emit-invokevirtual +lisp-stream-class+ "getElementType"
+           (emit-checkcast +lisp-stream+)
+           (emit-invokevirtual +lisp-stream+ "getElementType"
                                nil +lisp-object+)
            (emit-move-from-stack target representation))
@@ -5809 +4694 @@
            (compile-form arg1 'stack :int)
            (compile-form arg2 'stack nil)
-           (emit 'checkcast +lisp-stream-class+)
+           (emit-checkcast +lisp-stream+)
            (maybe-emit-clear-values arg1 arg2)
            (emit 'swap)
-           (emit-invokevirtual +lisp-stream-class+ "_writeByte" '("I") nil)
+           (emit-invokevirtual +lisp-stream+ "_writeByte" '(:int) nil)
            (when target
              (emit-push-nil)
@@ -5820 +4705 @@
            (compile-form arg2 'stack nil)
            (maybe-emit-clear-values arg1 arg2)
-           (emit-invokestatic +lisp-class+ "writeByte"
-                              (list "I" +lisp-object+) nil)
+           (emit-invokestatic +lisp+ "writeByte"
+                              (list :int +lisp-object+) nil)
            (when target
              (emit-push-nil)
@@ -5837 +4722 @@
          (cond ((compiler-subtypep type1 'stream)
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
-                (emit 'checkcast +lisp-stream-class+)
+                (emit-checkcast +lisp-stream+)
                 (emit-push-constant-int 1)
                 (emit-push-nil)
-                (emit-invokevirtual +lisp-stream-class+ "readLine"
-                                    (list "Z" +lisp-object+) +lisp-object+)
+                (emit-invokevirtual +lisp-stream+ "readLine"
+                                    (list :boolean +lisp-object+) +lisp-object+)
                 (emit-move-from-stack target))
                (t
@@ -5851 +4736 @@
          (cond ((and (compiler-subtypep type1 'stream) (null arg2))
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
-                (emit 'checkcast +lisp-stream-class+)
+                (emit-checkcast +lisp-stream+)
                 (emit-push-constant-int 0)
                 (emit-push-nil)
-                (emit-invokevirtual +lisp-stream-class+ "readLine"
-                                    (list "Z" +lisp-object+) +lisp-object+)
+                (emit-invokevirtual +lisp-stream+ "readLine"
+                                    (list :boolean +lisp-object+) +lisp-object+)
                 (emit-move-from-stack target)
                 )
@@ -6400 +5285 @@
                (compile-form arg1 'stack nil)
                (compile-form arg2 'stack nil)
-               (emit 'checkcast +lisp-abstract-vector-class+)
+               (emit-checkcast +lisp-abstract-vector+)
                (maybe-emit-clear-values arg1 arg2)
                (emit 'swap)
-               (emit-invokevirtual +lisp-abstract-vector-class+
+               (emit-invokevirtual +lisp-abstract-vector+
                                    (if (eq test 'eq) "deleteEq" "deleteEql")
                                    (lisp-object-arg-types 1) +lisp-object+)
@@ -6418 +5303 @@
     (ecase representation
       (:int
-       (emit-invokevirtual +lisp-object-class+ "length" nil "I"))
+       (emit-invokevirtual +lisp-object+ "length" nil :int))
       ((:long :float :double)
-       (emit-invokevirtual +lisp-object-class+ "length" nil "I")
+       (emit-invokevirtual +lisp-object+ "length" nil :int)
        (convert-representation :int representation))
       (:boolean
        ;; FIXME We could optimize this all away in unsafe calls.
-       (emit-invokevirtual +lisp-object-class+ "length" nil "I")
+       (emit-invokevirtual +lisp-object+ "length" nil :int)
        (emit 'pop)
        (emit 'iconst_1))
@@ -6431 +5316 @@
        (aver nil))
       ((nil)
-       (emit-invokevirtual +lisp-object-class+ "LENGTH" nil +lisp-object+)))
+       (emit-invokevirtual +lisp-object+ "LENGTH" nil +lisp-object+)))
     (emit-move-from-stack target representation)))
 
@@ -6442 +5327 @@
     (cond ((>= 4 length 1)
      (dolist (cons-head cons-heads)
-       (emit 'new +lisp-cons-class+)
+       (emit-new +lisp-cons+)
        (emit 'dup)
        (compile-form cons-head 'stack nil))
@@ -6449 +5334 @@
        (progn
          (emit-invokespecial-init 
-    +lisp-cons-class+ (lisp-object-arg-types 1))
+    +lisp-cons+ (lisp-object-arg-types 1))
          (pop cons-heads))) ; we've handled one of the args, so remove it
      (dolist (cons-head cons-heads)
        (declare (ignore cons-head))
        (emit-invokespecial-init 
-        +lisp-cons-class+ (lisp-object-arg-types 2)))
+        +lisp-cons+ (lisp-object-arg-types 2)))
      (if list-star-p 
          (progn
@@ -6481 +5366 @@
                  list-form 'stack nil)
     (emit 'swap)
-    (emit-invokevirtual +lisp-object-class+ "NTH" '("I") +lisp-object+)
+    (emit-invokevirtual +lisp-object+ "NTH" '(:int) +lisp-object+)
     (fix-boxing representation nil) ; FIXME use derived result type
     (emit-move-from-stack target representation)))
@@ -6520 +5405 @@
         (compile-forms-and-maybe-emit-clear-values arg1 'stack nil)
               (emit-push-int arg2)
-              (emit-invokevirtual +lisp-object-class+ "multiplyBy" '("I") +lisp-object+)
+              (emit-invokevirtual +lisp-object+ "multiplyBy" '(:int) +lisp-object+)
               (fix-boxing representation result-type)
               (emit-move-from-stack target representation))
@@ -6570 +5455 @@
                   (compile-form arg2 'stack nil)
                   (emit-dup nil :past nil)
-                  (emit-invokevirtual +lisp-object-class+
+                  (emit-invokevirtual +lisp-object+
                                       (if (eq op 'max)
                                           "isLessThanOrEqualTo"
                                           "isGreaterThanOrEqualTo")
-                                      (lisp-object-arg-types 1) "Z")
+                                      (lisp-object-arg-types 1) :boolean)
                   (let ((LABEL1 (gensym)))
                     (emit 'ifeq LABEL1)
@@ -6638 +5523 @@
               (when (fixnum-type-p type1)
                 (emit 'swap))
-              (emit-invokevirtual +lisp-object-class+ "add"
-                                  '("I") +lisp-object+)
+              (emit-invokevirtual +lisp-object+ "add"
+                                  '(:int) +lisp-object+)
               (fix-boxing representation result-type)
               (emit-move-from-stack target representation))
@@ -6677 +5562 @@
              (t
         (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-              (emit-invokevirtual +lisp-object-class+ "negate"
+              (emit-invokevirtual +lisp-object+ "negate"
                                   nil +lisp-object+)
               (fix-boxing representation nil)
@@ -6709 +5594 @@
                     arg1 'stack nil
                     arg2 'stack :int)
-              (emit-invokevirtual +lisp-object-class+
+              (emit-invokevirtual +lisp-object+
                                   "subtract"
-                                  '("I") +lisp-object+)
+                                  '(:int) +lisp-object+)
               (fix-boxing representation result-type)
               (emit-move-from-stack target representation))
@@ -6733 +5618 @@
                 (zerop *safety*))
            (compile-form arg1 'stack nil)
-           (emit 'checkcast +lisp-abstract-string-class+)
+           (emit-checkcast +lisp-abstract-string+)
            (compile-form arg2 'stack :int)
            (maybe-emit-clear-values arg1 arg2)
-           (emit-invokevirtual +lisp-abstract-string-class+ "charAt"
-                               '("I") "C")
+           (emit-invokevirtual +lisp-abstract-string+ "charAt"
+                               '(:int) :char)
            (emit-move-from-stack target representation))
           ((and (eq representation :char)
@@ -6744 +5629 @@
                 (fixnum-type-p type2))
            (compile-form arg1 'stack nil)
-           (emit 'checkcast +lisp-abstract-string-class+)
+           (emit-checkcast +lisp-abstract-string+)
            (compile-form arg2 'stack :int)
            (maybe-emit-clear-values arg1 arg2)
-           (emit-invokevirtual +lisp-abstract-string-class+ "charAt"
-                               '("I") "C")
+           (emit-invokevirtual +lisp-abstract-string+ "charAt"
+                               '(:int) :char)
            (emit-move-from-stack target representation))
           ((fixnum-type-p type2)
      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                   arg2 'stack :int)
-           (emit-invokevirtual +lisp-object-class+
+           (emit-invokevirtual +lisp-object+
                                (symbol-name op) ;; "CHAR" or "SCHAR"
-                               '("I") +lisp-object+)
+                               '(:int) +lisp-object+)
            (when (eq representation :char)
              (emit-unbox-character))
@@ -6782 +5667 @@
                   (value-register (when target (allocate-register)))
                   (class (if (eq op 'SCHAR)
-                             +lisp-simple-string-class+
-                             +lisp-abstract-string-class+)))
+                             +lisp-simple-string+
+                             +lisp-abstract-string+)))
              (compile-form arg1 'stack nil)
-             (emit 'checkcast class)
+             (emit-checkcast class)
              (compile-form arg2 'stack :int)
              (compile-form arg3 'stack :char)
@@ -6792 +5677 @@
                (emit-move-from-stack value-register :char))
              (maybe-emit-clear-values arg1 arg2 arg3)
-             (emit-invokevirtual class "setCharAt" '("I" "C") nil)
+             (emit-invokevirtual class "setCharAt" '(:int :char) nil)
              (when target
                (emit 'iload value-register)
@@ -6808 +5693 @@
      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                   arg2 'stack :int)
-           (emit-invokevirtual +lisp-object-class+ "SVREF" '("I") +lisp-object+)
+           (emit-invokevirtual +lisp-object+ "SVREF" '(:int) +lisp-object+)
            (fix-boxing representation nil)
            (emit-move-from-stack target representation)))
@@ -6828 +5713 @@
              (emit-move-from-stack value-register nil))
            (maybe-emit-clear-values arg1 arg2 arg3)
-           (emit-invokevirtual +lisp-object-class+ "svset" (list "I" +lisp-object+) nil)
+           (emit-invokevirtual +lisp-object+ "svset" (list :int +lisp-object+) nil)
            (when value-register
              (aload value-register)
@@ -6853 +5738 @@
     (compile-form arg1 'stack nil)
     (compile-form arg2 'stack nil)
-    (emit-invokevirtual +lisp-object-class+ "truncate" (lisp-object-arg-types 1) +lisp-object+)
+    (emit-invokevirtual +lisp-object+ "truncate" (lisp-object-arg-types 1) +lisp-object+)
     (fix-boxing representation nil) ; FIXME use derived result type
     (emit-move-from-stack target representation)))
@@ -6863 +5748 @@
          (compile-form (second form) 'stack nil)
          (compile-form (third form) 'stack :int)
-         (emit-invokevirtual +lisp-object-class+ "elt" '("I") +lisp-object+)
+         (emit-invokevirtual +lisp-object+ "elt" '(:int) +lisp-object+)
          (fix-boxing representation nil) ; FIXME use derived result type
          (emit-move-from-stack target representation))
@@ -6880 +5765 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack :int)
-          (emit-invokevirtual +lisp-object-class+ "aref" '("I") "I"))
+          (emit-invokevirtual +lisp-object+ "aref" '(:int) :int))
          (:long
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack :int)
-          (emit-invokevirtual +lisp-object-class+ "aref_long" '("I") "J"))
+          (emit-invokevirtual +lisp-object+ "aref_long" '(:int) :long))
          (:char
           (cond ((compiler-subtypep type1 'string)
                  (compile-form arg1 'stack nil) ; array
-                 (emit 'checkcast +lisp-abstract-string-class+)
+                 (emit-checkcast +lisp-abstract-string+)
                  (compile-form arg2 'stack :int) ; index
                  (maybe-emit-clear-values arg1 arg2)
-                 (emit-invokevirtual +lisp-abstract-string-class+
-                                     "charAt" '("I") "C"))
+                 (emit-invokevirtual +lisp-abstract-string+
+                                     "charAt" '(:int) :char))
                 (t
      (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                   arg2 'stack :int)
-                 (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+)
+                 (emit-invokevirtual +lisp-object+ "AREF" '(:int) +lisp-object+)
                  (emit-unbox-character))))
          ((nil :float :double :boolean)
@@ -6903 +5788 @@
     (compile-forms-and-maybe-emit-clear-values arg1 'stack nil
                  arg2 'stack :int)
-          (emit-invokevirtual +lisp-object-class+ "AREF" '("I") +lisp-object+)
+          (emit-invokevirtual +lisp-object+ "AREF" '(:int) +lisp-object+)
           (convert-representation nil representation)))
        (emit-move-from-stack target representation)))
@@ -6936 +5821 @@
            (maybe-emit-clear-values arg1 arg2 arg3)
            (cond ((fixnum-type-p type3)
-                  (emit-invokevirtual +lisp-object-class+ "aset" '("I" "I") nil))
+                  (emit-invokevirtual +lisp-object+ "aset" '(:int :int) nil))
                  (t
-                  (emit-invokevirtual +lisp-object-class+ "aset" (list "I" +lisp-object+) nil)))
+                  (emit-invokevirtual +lisp-object+ "aset" (list :int +lisp-object+) nil)))
            (when value-register
              (cond ((fixnum-type-p type3)
@@ -6961 +5846 @@
            (case arg2
              (0
-              (emit-invokevirtual +lisp-object-class+ "getSlotValue_0"
+              (emit-invokevirtual +lisp-object+ "getSlotValue_0"
                                   nil +lisp-object+))
              (1
-              (emit-invokevirtual +lisp-object-class+ "getSlotValue_1"
+              (emit-invokevirtual +lisp-object+ "getSlotValue_1"
                                   nil +lisp-object+))
              (2
-              (emit-invokevirtual +lisp-object-class+ "getSlotValue_2"
+              (emit-invokevirtual +lisp-object+ "getSlotValue_2"
                                   nil +lisp-object+))
              (3
-              (emit-invokevirtual +lisp-object-class+ "getSlotValue_3"
+              (emit-invokevirtual +lisp-object+ "getSlotValue_3"
                                   nil +lisp-object+))
              (t
               (emit-push-constant-int arg2)
-              (emit-invokevirtual +lisp-object-class+ "getSlotValue"
-                                  '("I") +lisp-object+)))
+              (emit-invokevirtual +lisp-object+ "getSlotValue"
+                                  '(:int) +lisp-object+)))
            (emit-move-from-stack target representation))
           ((fixnump arg2)
@@ -6982 +5867 @@
            (ecase representation
              (:int
-              (emit-invokevirtual +lisp-object-class+ "getFixnumSlotValue"
-                                  '("I") "I"))
+              (emit-invokevirtual +lisp-object+ "getFixnumSlotValue"
+                                  '(:int) :int))
              ((nil :char :long :float :double)
-              (emit-invokevirtual +lisp-object-class+ "getSlotValue"
-                                  '("I") +lisp-object+)
+              (emit-invokevirtual +lisp-object+ "getSlotValue"
+                                  '(:int) +lisp-object+)
               ;; (convert-representation NIL NIL) is a no-op
               (convert-representation nil representation))
              (:boolean
-              (emit-invokevirtual +lisp-object-class+ "getSlotValueAsBoolean"
-                                  '("I") "Z")))
+              (emit-invokevirtual +lisp-object+ "getSlotValueAsBoolean"
+                                  '(:int) :boolean)))
            (emit-move-from-stack target representation))
           (t
@@ -7012 +5897 @@
               (emit 'dup)
               (astore value-register))
-            (emit-invokevirtual +lisp-object-class+
+            (emit-invokevirtual +lisp-object+
                                 (format nil "setSlotValue_~D" arg2)
                                 (lisp-object-arg-types 1) nil)
@@ -7029 +5914 @@
               (emit 'dup)
               (astore value-register))
-            (emit-invokevirtual +lisp-object-class+ "setSlotValue"
-                                (list "I" +lisp-object+) nil)
+            (emit-invokevirtual +lisp-object+ "setSlotValue"
+                                (list :int +lisp-object+) nil)
             (when value-register
               (aload value-register)
@@ -7095 +5980 @@
                   arg2 'stack nil)
            (emit 'swap)
-           (emit-invokevirtual +lisp-object-class+ "nthcdr" '("I") +lisp-object+)
+           (emit-invokevirtual +lisp-object+ "nthcdr" '(:int) +lisp-object+)
            (fix-boxing representation nil)
            (emit-move-from-stack target representation))
@@ -7171 +6056 @@
       (0
        (emit-push-current-thread)
-       (emit-invokevirtual +lisp-thread-class+ "setValues" nil +lisp-object+)
+       (emit-invokevirtual +lisp-thread+ "setValues" nil +lisp-object+)
        (emit-move-from-stack target))
       (1
@@ -7191 +6076 @@
                 (compile-form arg1 'stack nil)
                 (compile-form arg2 'stack nil))))
-       (emit-invokevirtual +lisp-thread-class+
+       (emit-invokevirtual +lisp-thread+
                            "setValues"
                            (lisp-object-arg-types len)
@@ -7201 +6086 @@
        (dolist (arg args)
          (compile-form arg 'stack nil))
-       (emit-invokevirtual +lisp-thread-class+
+       (emit-invokevirtual +lisp-thread+
                            "setValues"
                            (lisp-object-arg-types len)
@@ -7228 +6113 @@
            ;; "... a reference to a symbol declared with DEFCONSTANT always
            ;; refers to its global value."
-           (emit-invokevirtual +lisp-symbol-class+ "getSymbolValue"
+           (emit-invokevirtual +lisp-symbol+ "getSymbolValue"
                                nil +lisp-object+))
           ((and (variable-binding-register variable)
@@ -7235 +6120 @@
                       (variable-block variable))))
            (aload (variable-binding-register variable))
-           (emit 'getfield +lisp-special-binding-class+ "value"
+           (emit-getfield +lisp-special-binding+ "value"
                  +lisp-object+))
           (t
            (emit-push-current-thread)
-           (emit-invokevirtual +lisp-symbol-class+ "symbolValue"
+           (emit-invokevirtual +lisp-symbol+ "symbolValue"
                                (list +lisp-thread+) +lisp-object+)))
     (fix-boxing representation nil)
@@ -7270 +6155 @@
          (emit-push-current-thread)
          (compile-form (%cadr form) 'stack nil)
-         (emit 'checkcast +lisp-symbol-class+)
+         (emit-checkcast +lisp-symbol+)
          (compile-form (%caddr form) 'stack nil)
          (maybe-emit-clear-values (%cadr form) (%caddr form))
-         (emit-invokevirtual +lisp-thread-class+ "setSpecialVariable"
+         (emit-invokevirtual +lisp-thread+ "setSpecialVariable"
                              (list +lisp-symbol+ +lisp-object+) +lisp-object+)
          (fix-boxing representation nil)
@@ -7315 +6200 @@
              (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
              (emit 'dup_x1) ;; copy past th
-             (emit 'putfield +lisp-special-binding-class+ "value"
+             (emit-putfield +lisp-special-binding+ "value"
                    +lisp-object+))
             ((and (consp value-form)
@@ -7325 +6210 @@
              (emit-load-externalized-object name)
        (compile-forms-and-maybe-emit-clear-values (second value-form) 'stack nil)
-             (emit-invokevirtual +lisp-thread-class+ "pushSpecial"
+             (emit-invokevirtual +lisp-thread+ "pushSpecial"
                                  (list +lisp-symbol+ +lisp-object+) +lisp-object+))
             (t
@@ -7331 +6216 @@
              (emit-load-externalized-object name)
        (compile-forms-and-maybe-emit-clear-values value-form 'stack nil)
-             (emit-invokevirtual +lisp-thread-class+ "setSpecialVariable"
+             (emit-invokevirtual +lisp-thread+ "setSpecialVariable"
                                  (list +lisp-symbol+ +lisp-object+) +lisp-object+)))
       (fix-boxing representation nil)
@@ -7410 +6295 @@
          (let ((arg (%cadr form)))
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-           (emit-invokevirtual +lisp-object-class+ "sxhash" nil "I")
+           (emit-invokevirtual +lisp-object+ "sxhash" nil :int)
            (convert-representation :int representation)
            (emit-move-from-stack target representation)))
@@ -7422 +6307 @@
     (cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-           (emit 'checkcast +lisp-symbol-class+)
-           (emit 'getfield  +lisp-symbol-class+ "name" +lisp-simple-string+)
+           (emit-checkcast +lisp-symbol+)
+           (emit-getfield  +lisp-symbol+ "name" +lisp-simple-string+)
            (emit-move-from-stack target representation))
           (t
@@ -7434 +6319 @@
     (cond ((and (eq (derive-compiler-type arg) 'SYMBOL) (< *safety* 3))
      (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-           (emit 'checkcast +lisp-symbol-class+)
-           (emit-invokevirtual +lisp-symbol-class+ "getPackage"
+           (emit-checkcast +lisp-symbol+)
+           (emit-invokevirtual +lisp-symbol+ "getPackage"
                                nil +lisp-object+)
            (fix-boxing representation nil)
@@ -7448 +6333 @@
       (when (eq (derive-compiler-type arg) 'SYMBOL)
   (compile-forms-and-maybe-emit-clear-values arg 'stack nil)
-        (emit 'checkcast +lisp-symbol-class+)
+        (emit-checkcast +lisp-symbol+)
         (emit-push-current-thread)
-        (emit-invokevirtual +lisp-symbol-class+ "symbolValue"
+        (emit-invokevirtual +lisp-symbol+ "symbolValue"
                             (list +lisp-thread+) +lisp-object+)
         (fix-boxing representation nil)
@@ -7463 +6348 @@
   (declare (type symbol expected-type))
   (let ((instanceof-class (ecase expected-type
-                            (SYMBOL     +lisp-symbol-class+)
-                            (CHARACTER  +lisp-character-class+)
-                            (CONS       +lisp-cons-class+)
-                            (HASH-TABLE +lisp-hash-table-class+)
-                            (FIXNUM     +lisp-fixnum-class+)
-          (STREAM     +lisp-stream-class+)
-                            (STRING     +lisp-abstract-string-class+)
-                            (VECTOR     +lisp-abstract-vector-class+)))
+                            (SYMBOL     +lisp-symbol+)
+                            (CHARACTER  +lisp-character+)
+                            (CONS       +lisp-cons+)
+                            (HASH-TABLE +lisp-hash-table+)
+                            (FIXNUM     +lisp-fixnum+)
+          (STREAM     +lisp-stream+)
+                            (STRING     +lisp-abstract-string+)
+                            (VECTOR     +lisp-abstract-vector+)))
         (expected-type-java-symbol-name (case expected-type
                                           (HASH-TABLE "HASH_TABLE")
@@ -7477 +6362 @@
         (LABEL1 (gensym)))
     (emit 'dup)
-    (emit 'instanceof instanceof-class)
+    (emit-instanceof instanceof-class)
     (emit 'ifne LABEL1)
-    (emit-getstatic +lisp-symbol-class+ expected-type-java-symbol-name +lisp-symbol+)
-    (emit-invokestatic +lisp-class+ "type_error"
+    (emit-getstatic +lisp-symbol+ expected-type-java-symbol-name +lisp-symbol+)
+    (emit-invokestatic +lisp+ "type_error"
                        (lisp-object-arg-types 2) +lisp-object+)
     (label LABEL1))
@@ -7631 +6516 @@
          (EXIT (gensym)))
     (compile-form (cadr form) 'stack nil)
-    (emit-invokevirtual +lisp-object-class+ "lockableInstance" nil
+    (emit-invokevirtual +lisp-object+ "lockableInstance" nil
                         +java-object+) ; value to synchronize
     (emit 'dup)
@@ -7648 +6533 @@
     (aload object-register)
     (emit 'monitorexit)
-    (push (make-handler :from BEGIN-PROTECTED-RANGE
-                        :to END-PROTECTED-RANGE
-                        :code END-PROTECTED-RANGE
-                        :catch-type 0) *handlers*)))
+    (add-exception-handler BEGIN-PROTECTED-RANGE
+                           END-PROTECTED-RANGE
+                           END-PROTECTED-RANGE nil)))
 
 
@@ -7672 +6556 @@
       (emit-push-current-thread)
       (aload tag-register)
-      (emit-invokevirtual +lisp-thread-class+ "pushCatchTag"
+      (emit-invokevirtual +lisp-thread+ "pushCatchTag"
                           (lisp-object-arg-types 1) nil)
       (let ((*blocks* (cons block *blocks*)))
@@ -7683 +6567 @@
       ;; The Throw object is on the runtime stack. Stack depth is 1.
       (emit 'dup) ; Stack depth is 2.
-      (emit 'getfield +lisp-throw-class+ "tag" +lisp-object+) ; Still 2.
+      (emit-getfield +lisp-throw+ "tag" +lisp-object+) ; Still 2.
       (aload tag-register) ; Stack depth is 3.
       ;; If it's not the tag we're looking for, we branch to the start of the
@@ -7689 +6573 @@
       (emit 'if_acmpne DEFAULT-HANDLER) ; Stack depth is 1.
       (emit-push-current-thread)
-      (emit-invokevirtual +lisp-throw-class+ "getResult"
+      (emit-invokevirtual +lisp-throw+ "getResult"
                           (list +lisp-thread+) +lisp-object+)
       (emit-move-from-stack target) ; Stack depth is 0.
@@ -7696 +6580 @@
       ;; A Throwable object is on the runtime stack here. Stack depth is 1.
       (emit-push-current-thread)
-      (emit-invokevirtual +lisp-thread-class+ "popCatchTag" nil nil)
+      (emit-invokevirtual +lisp-thread+ "popCatchTag" nil nil)
       (emit 'athrow) ; Re-throw.
       (label EXIT)
       ;; Finally...
       (emit-push-current-thread)
-      (emit-invokevirtual +lisp-thread-class+ "popCatchTag" nil nil)
-      (let ((handler1 (make-handler :from BEGIN-PROTECTED-RANGE
-                                    :to END-PROTECTED-RANGE
-                                    :code THROW-HANDLER
-                                    :catch-type (pool-class +lisp-throw-class+)))
-            (handler2 (make-handler :from BEGIN-PROTECTED-RANGE
-                                    :to END-PROTECTED-RANGE
-                                    :code DEFAULT-HANDLER
-                                    :catch-type 0)))
-        (push handler1 *handlers*)
-        (push handler2 *handlers*))))
+      (emit-invokevirtual +lisp-thread+ "popCatchTag" nil nil)
+      (add-exception-handler BEGIN-PROTECTED-RANGE
+                             END-PROTECTED-RANGE
+                             THROW-HANDLER +lisp-throw+)
+      (add-exception-handler BEGIN-PROTECTED-RANGE
+                             END-PROTECTED-RANGE
+                             DEFAULT-HANDLER nil)))
   t)
 
@@ -7721 +6601 @@
   (emit-clear-values) ; Do this unconditionally! (MISC.503)
   (compile-form (third form) 'stack nil) ; Result.
-  (emit-invokevirtual +lisp-thread-class+ "throwToTag"
+  (emit-invokevirtual +lisp-thread+ "throwToTag"
                       (lisp-object-arg-types 2) nil)
   ;; Following code will not be reached.
@@ -7764 +6644 @@
         (unless (single-valued-p protected-form)
           (emit-push-current-thread)
-          (emit 'getfield +lisp-thread-class+ "_values" +lisp-object-array+)
+          (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
           (astore values-register))
         (label END-PROTECTED-RANGE))
@@ -7777 +6657 @@
       (astore exception-register)
       (emit-push-current-thread)
-      (emit 'getfield +lisp-thread-class+ "_values" +lisp-object-array+)
+      (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
       (astore values-register)
       (let ((*register* *register*))
@@ -7785 +6665 @@
       (emit-push-current-thread)
       (aload values-register)
-      (emit 'putfield +lisp-thread-class+ "_values" +lisp-object-array+)
+      (emit-putfield +lisp-thread+ "_values" +lisp-object-array+)
       (aload exception-register)
       (emit 'athrow) ; Re-throw exception.
@@ -7793 +6673 @@
         (emit-push-current-thread)
         (aload values-register)
-        (emit 'putfield +lisp-thread-class+ "_values" +lisp-object-array+))
+        (emit-putfield +lisp-thread+ "_values" +lisp-object-array+))
       ;; Result.
       (aload result-register)
       (emit-move-from-stack target)
-      (let ((handler (make-handler :from BEGIN-PROTECTED-RANGE
-                                   :to END-PROTECTED-RANGE
-                                   :code HANDLER
-                                   :catch-type 0)))
-        (push handler *handlers*)))))
+      (add-exception-handler BEGIN-PROTECTED-RANGE
+                             END-PROTECTED-RANGE HANDLER nil))))
 
 (defknown compile-form (t t t) t)
@@ -7885 +6762 @@
 
 
-;; Returns descriptor.
+;; Returns a list with the types of the arguments
 (defun analyze-args (compiland)
   (let* ((args (cadr (compiland-p1-result compiland)))
@@ -7892 +6769 @@
     (aver (not (memq '&AUX args)))
 
-    (when *child-p*
-      (when (or (memq '&KEY args)
-                (memq '&OPTIONAL args)
-                (memq '&REST args))
-        (setf *using-arg-array* t)
-        (setf *hairy-arglist-p* t)
-        (return-from analyze-args
-          (get-descriptor (list +lisp-object-array+) +lisp-object+)))
-      (return-from analyze-args
-        (cond ((<= arg-count call-registers-limit)
-               (get-descriptor (lisp-object-arg-types arg-count) +lisp-object+))
-              (t (setf *using-arg-array* t)
-                 (setf (compiland-arity compiland) arg-count)
-                 (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
     (when (or (memq '&KEY args)
               (memq '&OPTIONAL args)
               (memq '&REST args))
-      (setf *using-arg-array* t)
-      (setf *hairy-arglist-p* t)
-      (return-from analyze-args
-                   (get-descriptor (list +lisp-object-array+) +lisp-object+)))
+      (setf *using-arg-array* t
+            *hairy-arglist-p* t)
+      (return-from analyze-args (list +lisp-object-array+)))
+
     (cond ((<= arg-count call-registers-limit)
-           (get-descriptor (lisp-object-arg-types (length args))
-                            +lisp-object+))
-          (t
-           (setf *using-arg-array* t)
-           (setf (compiland-arity compiland) arg-count)
-           (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
+           (lisp-object-arg-types arg-count))
+          (t (setf *using-arg-array* t)
+             (setf (compiland-arity compiland) arg-count)
+             (list +lisp-object-array+)))))
 
 (defmacro with-open-class-file ((var class-file) &body body)
   `(with-open-file (,var (abcl-class-file-pathname ,class-file)
-       :direction :output
-       :element-type '(unsigned-byte 8)
-       :if-exists :supersede)
+                         :direction :output
+                         :element-type '(unsigned-byte 8)
+                         :if-exists :supersede)
      ,@body))
 
-(defun write-class-file (class-file stream)
-  (let* ((super (abcl-class-file-superclass class-file))
-         (this-index (pool-class (abcl-class-file-class class-file)))
-         (super-index (pool-class super))
-         (constructor (make-constructor super
-                                        (abcl-class-file-lambda-name class-file)
-                                        (abcl-class-file-lambda-list class-file))))
-    (pool-name "Code") ; Must be in pool!
-
-    (when *file-compilation*
-      (pool-name "SourceFile") ; Must be in pool!
-      (pool-name (file-namestring *compile-file-truename*)))
-    (when (and (boundp '*source-line-number*)
-               (fixnump *source-line-number*))
-      (pool-name "LineNumberTable")) ; Must be in pool!
-    
-    (write-u4 #xCAFEBABE stream)
-    (write-u2 3 stream)
-    (write-u2 45 stream)
-    (write-constant-pool stream)
-    ;; access flags
-    (write-u2 #x21 stream)
-    (write-u2 this-index stream)
-    (write-u2 super-index stream)
-    ;; interfaces count
-    (write-u2 0 stream)
-    ;; fields count
-    (write-u2 (length *fields*) stream)
-    ;; fields
-    (dolist (field *fields*)
-      (write-field field stream))
-    ;; methods count
-    (write-u2 (1+ (length (abcl-class-file-methods class-file))) stream)
-    ;; methods
-    (dolist (method (abcl-class-file-methods class-file))
-      (write-method method stream))
-    (write-method constructor stream)
-    ;; attributes count
-    (cond (*file-compilation*
-     ;; attributes count
-     (write-u2 1 stream)
-     ;; attributes table
-     (write-source-file-attr (file-namestring *compile-file-truename*)
-           stream))
-    (t
-     ;; attributes count
-     (write-u2 0 stream)))
-    stream))
 
 (defknown p2-compiland-process-type-declarations (list) t)
@@ -8038 +6851 @@
          (*child-p* (not (null (compiland-parent compiland))))
 
-         (descriptor (analyze-args compiland))
-         (execute-method (make-method :name "execute"
-                                      :descriptor descriptor))
+         (arg-types (analyze-args compiland))
+         (method (make-method "execute" +lisp-object+ arg-types
+                               :flags '(:final :public)))
+         (code (method-add-code method))
+         (*current-code-attribute* code)
          (*code* ())
          (*register* 1) ;; register 0: "this" pointer
          (*registers-allocated* 1)
-         (*handlers* ())
          (*visible-variables* *visible-variables*)
 
@@ -8050 +6864 @@
          (*initialize-thread-var* nil)
          (label-START (gensym)))
+
+    (class-add-method class-file method)
+    (when (fixnump *source-line-number*)
+      (let ((table (make-line-numbers-attribute)))
+        (method-add-attribute method table)
+        (line-numbers-add-line table 0 *source-line-number*)))
 
     (dolist (var (compiland-arg-vars compiland))
@@ -8083 +6903 @@
             ;; if we're the ultimate parent: create the closure array
             (emit-push-constant-int (length *closure-variables*))
-            (emit 'anewarray +closure-binding-class+))
+            (emit-anewarray +lisp-closure-binding+))
         (progn
           (aload 0)
-          (emit 'getfield +lisp-compiled-closure-class+ "ctx"
+          (emit-getfield +lisp-compiled-closure+ "ctx"
                 +closure-binding-array+)
           (when local-closure-vars
@@ -8110 +6930 @@
             (emit 'dup) ; array
             (emit-push-constant-int i)
-            (emit 'new +closure-binding-class+)
+            (emit-new +lisp-closure-binding+)
             (emit 'dup)
             (cond
@@ -8128 +6948 @@
               (t
                (assert (not "Can't happen!!"))))
-            (emit-invokespecial-init +closure-binding-class+
+            (emit-invokespecial-init +lisp-closure-binding+
                                      (list +lisp-object+))
             (emit 'aastore)))))
@@ -8180 +7000 @@
                  (emit 'aaload)
                  (setf (variable-index variable) nil)))
-          (emit-invokevirtual +lisp-thread-class+ "bindSpecial"
+          (emit-invokevirtual +lisp-thread+ "bindSpecial"
                               (list +lisp-symbol+ +lisp-object+)
                               +lisp-special-binding+)
@@ -8222 +7042 @@
         (astore (compiland-argument-register compiland)))
 
-      (maybe-initialize-thread-var)
+      (unless (and *hairy-arglist-p*
+                   (or (memq '&OPTIONAL args) (memq '&KEY args)))
+        (maybe-initialize-thread-var))
       (setf *code* (nconc code *code*)))
 
@@ -8228 +7050 @@
           (if (or *hairy-arglist-p*
       (and *child-p* *closure-variables*))
-        +lisp-compiled-closure-class+
-      +lisp-primitive-class+))
+        +lisp-compiled-closure+
+      +lisp-primitive+))
 
     (setf (abcl-class-file-lambda-list class-file) args)
-    (setf (method-max-locals execute-method) *registers-allocated*)
-    (push execute-method (abcl-class-file-methods class-file))
-
-
-    ;;;  Move here
-    (finalize-code)
-    (optimize-code)
-
-    (setf *code* (resolve-instructions *code*))
-    (setf (method-max-stack execute-method) (analyze-stack))
-    (setf (method-code execute-method) (code-bytes *code*))
-
-    ;; Remove handler if its protected range is empty.
-    (setf *handlers*
-          (delete-if (lambda (handler)
-                       (eql (symbol-value (handler-from handler))
-                            (symbol-value (handler-to handler))))
-                     *handlers*))
-    ;;; to here
-    ;;; To a separate function which is part of class file finalization
-    ;;;  when we have a section of class-file-generation centered code
-
-
-    (setf (method-handlers execute-method) (nreverse *handlers*)))
+    (setf (code-max-locals code) *registers-allocated*)
+    (setf (code-code code) *code*))
+
+
   t)
 
@@ -8272 +7074 @@
         (*current-compiland* compiland))
     (with-saved-compiler-policy
-      ;; Pass 1.
-      (p1-compiland compiland)
-      ;; *all-variables* doesn't contain variables which
-      ;; are in an enclosing lexical environment (variable-environment)
-      ;; so we don't need to filter them out
-      (setf *closure-variables*
-            (remove-if #'variable-special-p
-                       (remove-if-not #'variable-used-non-locally-p
-                                                 *all-variables*)))
-      (let ((i 0))
-        (dolist (var (reverse *closure-variables*))
-          (setf (variable-closure-index var) i)
-          (dformat t "var = ~S closure index = ~S~%" (variable-name var)
-                   (variable-closure-index var))
-          (incf i)))
+        ;; Pass 1.
+        (p1-compiland compiland))
+
+    ;; *all-variables* doesn't contain variables which
+    ;; are in an enclosing lexical environment (variable-environment)
+    ;; so we don't need to filter them out
+    (setf *closure-variables*
+          (remove-if #'variable-special-p
+                     (remove-if-not #'variable-used-non-locally-p
+                                    *all-variables*)))
+    (let ((i 0))
+      (dolist (var (reverse *closure-variables*))
+        (setf (variable-closure-index var) i)
+        (dformat t "var = ~S closure index = ~S~%" (variable-name var)
+                 (variable-closure-index var))
+        (incf i)))
 
       ;; Assert that we're not refering to any variables
       ;; we're not allowed to use
-      (assert (= 0
-                 (length (remove-if (complement #'variable-references)
-                                    (remove-if #'variable-references-allowed-p
-                                               *visible-variables*)))))
+
+    (assert (= 0
+               (length (remove-if (complement #'variable-references)
+                                  (remove-if #'variable-references-allowed-p
+                                             *visible-variables*)))))
 
       ;; Pass 2.
-      (with-class-file (compiland-class-file compiland)
+
+    (with-class-file (compiland-class-file compiland)
+      (with-saved-compiler-policy
         (p2-compiland compiland)
-        (write-class-file (compiland-class-file compiland) stream)))))
+        ;;        (finalize-class-file (compiland-class-file compiland))
+        (finish-class (compiland-class-file compiland) stream)))))
 
 (defvar *compiler-error-bailout*)
@@ -8312 +7119 @@
   (aver (eq (car form) 'LAMBDA))
   (catch 'compile-defun-abort
-    (let* ((class-file (make-class-file :pathname filespec
-                                        :lambda-name name
-                                        :lambda-list (cadr form)))
+    (let* ((class-file (make-abcl-class-file :pathname filespec
+                                             :lambda-name name
+                                             :lambda-list (cadr form)))
            (*compiler-error-bailout*
             `(lambda ()
-               (compile-1 (make-compiland :name ',name
-                                          :lambda-expression (make-compiler-error-form ',form)
-                                          :class-file
-                                          (make-class-file :pathname ,filespec
-                                                           :lambda-name ',name
-                                                           :lambda-list (cadr ',form)))
-        ,stream)))
+               (compile-1
+                (make-compiland :name ',name
+                                :lambda-expression (make-compiler-error-form ',form)
+                                :class-file
+                                (make-abcl-class-file :pathname ,filespec
+                                                      :lambda-name ',name
+                                                      :lambda-list (cadr ',form)))
+                ,stream)))
            (*compile-file-environment* environment))
-        (compile-1 (make-compiland :name name
-                                   :lambda-expression
-                                   (precompiler:precompile-form form t
-                                                                environment)
-                                   :class-file class-file)
-       stream))))
+      (compile-1 (make-compiland :name name
+                                 :lambda-expression
+                                 (precompiler:precompile-form form t
+                                                              environment)
+                                 :class-file class-file)
+                 stream))))
 
 (defvar *catch-errors* t)

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

@@ -43 +43 @@
   (require "COMPILER-ERROR")
   (require "KNOWN-FUNCTIONS")
+  (require "DUMP-FORM")
+  (require "JVM-INSTRUCTIONS")
+  (require "JVM-CLASS-FILE")
   (require "KNOWN-SYMBOLS")
-  (require "DUMP-FORM")
-  (require "OPCODES")
   (require "JAVA")
   (require "COMPILER-PASS1")
@@ -61 +62 @@
 (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 "s2 argument ~A out of 16-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)))
+
+
+
 
 
@@ -78 +113 @@
 
 (defvar *pool* nil)
-(defvar *pool-count* 1)
-(defvar *pool-entries* nil)
-(defvar *fields* ())
 (defvar *static-code* ())
+(defvar *class-file* nil)
 
 (defvar *externalized-objects* nil)
 (defvar *declared-functions* nil)
 
-(defstruct (abcl-class-file (:constructor %make-abcl-class-file))
+(defstruct (abcl-class-file (:include class-file)
+                            (:constructor %make-abcl-class-file))
   pathname ; pathname of output file
+  class-name
   lambda-name
-  class
-  superclass
   lambda-list ; as advertised
-  pool
-  (pool-count 1)
-  (pool-entries (make-hash-table :test #'equal))
-  fields
-  methods
   static-code
   objects ;; an alist of externalized objects and their field names
@@ -108 +136 @@
       (declare (type fixnum i))
       (when (or (char= (char name i) #\-)
-    (char= (char name i) #\Space))
+                (char= (char name i) #\Space))
         (setf (char name i) #\_)))
-    (concatenate 'string "org/armedbear/lisp/" name)))
+    (make-class-name
+     (concatenate 'string "org.armedbear.lisp." name))))
 
 (defun make-unique-class-name ()
   "Creates a random class name for use with a `class-file' structure's
 `class' slot."
-  (concatenate 'string "abcl_"
-          (java:jcall (java:jmethod "java.lang.String" "replace" "char" "char")
-                      (java:jcall (java:jmethod "java.util.UUID" "toString")
-                             (java:jstatic "randomUUID" "java.util.UUID"))
-                      #\- #\_)))
-
-(defun make-class-file (&key pathname lambda-name lambda-list)
+  (make-class-name
+   (concatenate 'string "abcl_"
+                (substitute #\_ #\-
+                            (java:jcall (java:jmethod "java.util.UUID"
+                                                      "toString")
+                                        (java:jstatic "randomUUID"
+                                                      "java.util.UUID"))))))
+
+(defun make-abcl-class-file (&key pathname lambda-name lambda-list)
   "Creates a `class-file' structure. If `pathname' is non-NIL, it's
 used to derive a class name. If it is NIL, a random one created
@@ -129 +160 @@
                          (make-unique-class-name)))
          (class-file (%make-abcl-class-file :pathname pathname
-                                            :class class-name
+                                            :class class-name ; to be finalized
+                                            :class-name class-name
                                             :lambda-name lambda-name
-                                            :lambda-list lambda-list)))
+                                            :lambda-list lambda-list
+                                            :access-flags '(:public :final))))
+    (when *file-compilation*
+      (let ((source-attribute
+             (make-source-file-attribute
+              :filename (file-namestring *compile-file-truename*))))
+        (class-add-attribute class-file source-attribute)))
     class-file))
 
 (defmacro with-class-file (class-file &body body)
   (let ((var (gensym)))
-    `(let* ((,var ,class-file)
-            (*pool*                 (abcl-class-file-pool ,var))
-            (*pool-count*           (abcl-class-file-pool-count ,var))
-            (*pool-entries*         (abcl-class-file-pool-entries ,var))
-            (*fields*               (abcl-class-file-fields ,var))
+    `(let* ((,var                   ,class-file)
+            (*class-file*           ,var)
+            (*pool*                 (abcl-class-file-constants ,var))
             (*static-code*          (abcl-class-file-static-code ,var))
             (*externalized-objects* (abcl-class-file-objects ,var))
             (*declared-functions*   (abcl-class-file-functions ,var)))
        (progn ,@body)
-       (setf (abcl-class-file-pool ,var)         *pool*
-             (abcl-class-file-pool-count ,var)   *pool-count*
-             (abcl-class-file-pool-entries ,var) *pool-entries*
-             (abcl-class-file-fields ,var)       *fields*
-             (abcl-class-file-static-code ,var)  *static-code*
+       (setf (abcl-class-file-static-code ,var)  *static-code*
              (abcl-class-file-objects ,var)      *externalized-objects*
              (abcl-class-file-functions ,var)    *declared-functions*))))
@@ -196 +228 @@
 (defvar *this-class* nil)
 
-(defvar *code* ())
-
 ;; All tags visible at the current point of compilation, some of which may not
 ;; be in the current compiland.
@@ -207 +237 @@
 ;; Total number of registers allocated.
 (defvar *registers-allocated* 0)
-
-(defvar *handlers* ())
-
-(defstruct handler
-  from       ;; label indicating the start of the protected block
-  to         ;; label indicating the end of the protected block
-  code       ;; label to jump to if the specified exception occurs
-  catch-type ;; pool index of the class name of the exception, or 0 (zero)
-             ;; for 'all'
-  )
 
 ;; Variables visible at the current point of compilation.

trunk/abcl/src/org/armedbear/lisp/known-symbols.lisp

@@ -39 +39 @@
   (defun initialize-known-symbols (source ht)
     (let* ((source-class (java:jclass source))
-           (class-designator (substitute #\/ #\. source))
+           (class-designator (jvm::make-class-name source))
            (symbol-class (java:jclass "org.armedbear.lisp.Symbol"))
            (fields (java:jclass-fields source-class :declared t :public t)))

trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp

@@ -77 +77 @@
   (if (find :asdf2 *features*)
       (asdf:system-relative-pathname :ansi-compiled "test/lisp/ansi/ansi-test-failures")
-      (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*))))
+      (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))
 
 (defun parse (&optional (file *default-database-file*))