Changeset 12895

Timestamp:

08/13/10 21:10:39 (13 years ago)

Author:

ehuelsmann

Message:

Remove exclamation marks which were in place to avoid naming
conflicts; the conflicting names have been deleted from pass2 now.

Location:

branches/generic-class-file/abcl/src/org/armedbear/lisp

Files:

• compiler-pass2.lisp (modified) (12 diffs)
• jvm-class-file.lisp (modified) (17 diffs)
• jvm.lisp (modified) (1 diff)

branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

@@ -797 +797 @@
   (let* ((*compiler-debug* nil)
          ;; We don't normally need to see debugging output for constructors.
-         (method (!make-method :constructor :void nil
+         (method (make-method :constructor :void nil
                                :flags '(:public)))
          (code (method-add-code method))
@@ -3809 +3809 @@
 (defmacro with-temp-class-file (pathname class-file lambda-list &body body)
   `(let* ((,pathname (make-temp-file))
-    (,class-file (make-class-file :pathname ,pathname
+    (,class-file (make-abcl-class-file :pathname ,pathname
                                              :lambda-list ,lambda-list)))
      (unwind-protect
@@ -3821 +3821 @@
     (cond (*file-compilation*
            (let* ((pathname (funcall *pathnames-generator*))
-                  (class-file (make-class-file :pathname pathname
+                  (class-file (make-abcl-class-file :pathname pathname
                                                :lambda-list lambda-list)))
              (with-open-class-file (f class-file)
@@ -3827 +3827 @@
              (setf (local-function-class-file local-function) class-file)))
           (t
-           (let ((class-file (make-class-file :lambda-list lambda-list)))
+           (let ((class-file (make-abcl-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)
@@ -3855 +3855 @@
     (cond (*file-compilation*
            (let* ((pathname (funcall *pathnames-generator*))
-                  (class-file (make-class-file :pathname pathname
-                                               :lambda-list lambda-list)))
+                  (class-file (make-abcl-class-file :pathname pathname
+                                                    :lambda-list lambda-list)))
              (with-open-class-file (f class-file)
                (set-compiland-and-write-class class-file compiland f))
@@ -3864 +3864 @@
                 local-function compiland g))))
           (t
-           (let ((class-file (make-class-file :lambda-list lambda-list)))
+           (let ((class-file (make-abcl-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)
@@ -3917 +3917 @@
     (cond (*file-compilation*
            (setf (compiland-class-file compiland)
-                 (make-class-file :pathname (funcall *pathnames-generator*)
-                                  :lambda-list lambda-list))
+                 (make-abcl-class-file :pathname (funcall *pathnames-generator*)
+                                       :lambda-list lambda-list))
            (let ((class-file (compiland-class-file compiland)))
        (with-open-class-file (f class-file)
@@ -3928 +3928 @@
           (t
            (setf (compiland-class-file compiland)
-                 (make-class-file :lambda-list lambda-list))
+                 (make-abcl-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)
@@ -6851 +6851 @@
     ;; methods
     (dolist (method (abcl-class-file-methods class-file))
-      (!write-method method stream))
+      (write-method method stream))
     ;; attributes count
     (cond (*file-compilation*
@@ -6926 +6926 @@
 
          (arg-types (analyze-args compiland))
-         (method (!make-method "execute" +lisp-object+ arg-types
+         (method (make-method "execute" +lisp-object+ arg-types
                                :flags '(:final :public)))
          (code (method-add-code method))
@@ -7112 +7112 @@
         (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*)))
 
@@ -7181 +7183 @@
   (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)

branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

@@ -504 +504 @@
 
 (defstruct (class-file (:constructor
-                        !make-class-file (class superclass access-flags)))
+                        make-class-file (class superclass access-flags)))
   "Holds the components of a class file."
   (constants (make-pool))
@@ -534 +534 @@
   "Returns all methods which have `name'."
   (remove name (class-file-methods class)
-          :test-not #'string= :key #'!method-name))
+          :test-not #'string= :key #'method-name))
 
 (defun class-method (class name return &rest args)
@@ -540 +540 @@
   (let ((return-and-args (cons return args)))
     (find-if #'(lambda (c)
-                 (and (string= (!method-name c) name)
-                      (equal (!method-descriptor c) return-and-args)))
+                 (and (string= (method-name c) name)
+                      (equal (method-descriptor c) return-and-args)))
              (class-file-methods class))))
 
@@ -674 +674 @@
   ;; flags
   (write-u2  (class-file-access-flags class) stream)
+
   ;; class name
-
   (write-u2 (class-file-class class) stream)
+
   ;; superclass
   (write-u2 (class-file-superclass class) stream)
@@ -691 +692 @@
   (write-u2 (length (class-file-methods class)) stream)
   (dolist (method (class-file-methods class))
-    (!write-method method stream))
+    (write-method method stream))
 
   ;; attributes
@@ -832 +833 @@
 
 
-(defstruct (method (:constructor %!make-method)
-                   (:conc-name !method-))
+(defstruct (method (:constructor %make-method)
+                   (:conc-name method-))
   "Holds information on the properties of methods in the class(-file)."
   access-flags
@@ -855 +856 @@
     (t name)))
 
-(defun !make-method (name return args &key (flags '(:public)))
+(defun make-method (name return args &key (flags '(:public)))
   "Creates a method for addition to a class file."
-  (%!make-method :descriptor (cons return args)
+  (%make-method :descriptor (cons return args)
                 :access-flags flags
                 :name name))
@@ -864 +865 @@
   "Add `attribute' to the list of attributes of `method',
 returning `attribute'."
-  (push attribute (!method-attributes method))
+  (push attribute (method-attributes method))
   attribute)
 
@@ -872 +873 @@
   (method-add-attribute
    method
-   (make-code-attribute (+ (length (cdr (!method-descriptor method)))
-                           (if (member :static (!method-access-flags method))
+   (make-code-attribute (+ (length (cdr (method-descriptor method)))
+                           (if (member :static (method-access-flags method))
                                0 1))))) ;; 1 == implicit 'this'
 
@@ -886 +887 @@
 (defun method-attribute (method name)
   "Returns the first attribute of `method' with `name'."
-  (find name (!method-attributes method)
+  (find name (method-attributes method)
         :test #'string= :key #'attribute-name))
 
@@ -893 +894 @@
   "Prepares `method' for serialization."
   (let ((pool (class-file-constants class)))
-    (setf (!method-access-flags method)
-          (map-flags (!method-access-flags method))
-          (!method-descriptor method)
-          (pool-add-utf8 pool (apply #'descriptor (!method-descriptor method)))
-          (!method-name method)
-          (pool-add-utf8 pool (map-method-name (!method-name method)))))
-  (finalize-attributes (!method-attributes method) nil class))
-
-
-(defun !write-method (method stream)
+    (setf (method-access-flags method)
+          (map-flags (method-access-flags method))
+          (method-descriptor method)
+          (pool-add-utf8 pool (apply #'descriptor (method-descriptor method)))
+          (method-name method)
+          (pool-add-utf8 pool (map-method-name (method-name method)))))
+  (finalize-attributes (method-attributes method) nil class))
+
+
+(defun write-method (method stream)
   "Write class file representation of `method' to `stream'."
-  (write-u2 (!method-access-flags method) stream)
-  (write-u2 (!method-name method) stream)
-  ;;(sys::%format t "method-name: ~a~%" (!method-name method))
-  (write-u2 (!method-descriptor method) stream)
-  (write-attributes (!method-attributes method) stream))
+  (write-u2 (method-access-flags method) stream)
+  (write-u2 (method-name method) stream)
+  ;;(sys::%format t "method-name: ~a~%" (method-name method))
+  (write-u2 (method-descriptor method) stream)
+  (write-attributes (method-attributes method) stream))
 
 (defstruct attribute
@@ -951 +952 @@
                            (:include attribute
                                      (name "Code")
-                                     (finalizer #'!finalize-code)
-                                     (writer #'!write-code))
+                                     (finalizer #'finalize-code-attribute)
+                                     (writer #'write-code-attribute))
                            (:constructor %make-code-attribute))
   "The attribute containing the actual JVM byte code;
@@ -982 +983 @@
         (acons label offset (code-labels code))))
 
-(defun !finalize-code (code parent class)
+(defun finalize-code-attribute (code parent class)
   "Prepares the `code' attribute for serialization, within method `parent'."
   (declare (ignore parent))
@@ -1000 +1001 @@
             (code-labels code) labels)))
 
+  (setf (code-exception-handlers code)
+        (remove-if #'(lambda (h)
+                       (eql (code-label-offset code (exception-start-pc h))
+                            (code-label-offset code (exception-end-pc h))))
+                   (code-exception-handlers code)))
+
   (dolist (exception (code-exception-handlers code))
     (setf (exception-start-pc exception)
@@ -1015 +1022 @@
   (finalize-attributes (code-attributes code) code class))
 
-(defun !write-code (code stream)
+(defun write-code-attribute (code stream)
   "Writes the attribute `code' to `stream'."
   ;;(sys::%format t "max-stack: ~a~%" (code-max-stack code))
@@ -1086 +1093 @@
 
 "
-  
+  ;;; ### TODO
   )
 
@@ -1130 +1137 @@
   (setf (code-code code) *code*
         (code-max-locals code) *registers-allocated*
-;;        (code-exception-handlers code) *handlers*
         (code-current-local code) *register*))
 
 (defun restore-code-specials (code)
   (setf *code* (code-code code)
-;;        *handlers* (code-exception-handlers code)
         *registers-allocated* (code-max-locals code)
         *register* (code-current-local code)))

branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp

@@ -151 +151 @@
                                                       "java.util.UUID"))))))
 
-(defun make-class-file (&key pathname lambda-name lambda-list)
+(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