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

Erik Huelsmann ehuelsmann at common-lisp.net
Tue Feb 2 21:01:45 UTC 2010


Author: ehuelsmann
Date: Tue Feb  2 16:01:41 2010
New Revision: 12415

Log:
Rename class-file to abcl-class-file in anticipation of
 a more generic class file representation to come.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
   trunk/abcl/src/org/armedbear/lisp/jvm.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Tue Feb  2 16:01:41 2010
@@ -2171,7 +2171,7 @@
   (declare-with-hashtable
    local-function *declared-functions* ht g
    (setf g (symbol-name (gensym "LFUN")))
-   (let* ((pathname (class-file-pathname (local-function-class-file local-function)))
+   (let* ((pathname (abcl-class-file-pathname (local-function-class-file local-function)))
 	  (*code* *static-code*))
      ;; fixme *declare-inline*
      (declare-field g +lisp-object+ +field-access-default+)
@@ -8245,19 +8245,19 @@
            (get-descriptor (list +lisp-object-array+) +lisp-object+)))))
 
 (defmacro with-open-class-file ((var class-file) &body body)
-  `(with-open-file (,var (class-file-pathname ,class-file)
+  `(with-open-file (,var (abcl-class-file-pathname ,class-file)
 			 :direction :output
 			 :element-type '(unsigned-byte 8)
 			 :if-exists :supersede)
      , at body))
 
 (defun write-class-file (class-file stream)
-  (let* ((super (class-file-superclass class-file))
-         (this-index (pool-class (class-file-class class-file)))
+  (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
-                                        (class-file-lambda-name class-file)
-                                        (class-file-lambda-list class-file))))
+                                        (abcl-class-file-lambda-name class-file)
+                                        (abcl-class-file-lambda-list class-file))))
     (pool-name "Code") ; Must be in pool!
 
     (when *file-compilation*
@@ -8283,9 +8283,9 @@
     (dolist (field *fields*)
       (write-field field stream))
     ;; methods count
-    (write-u2 (1+ (length (class-file-methods class-file))) stream)
+    (write-u2 (1+ (length (abcl-class-file-methods class-file))) stream)
     ;; methods
-    (dolist (method (class-file-methods class-file))
+    (dolist (method (abcl-class-file-methods class-file))
       (write-method method stream))
     (write-method constructor stream)
     ;; attributes count
@@ -8351,7 +8351,7 @@
 ;;   (format t "p2-compiland name = ~S~%" (compiland-name compiland))
   (let* ((p1-result (compiland-p1-result compiland))
          (class-file (compiland-class-file compiland))
-         (*this-class* (class-file-class class-file))
+         (*this-class* (abcl-class-file-class class-file))
          (args (cadr p1-result))
          (closure-args (intersection *closure-variables*
                                      (compiland-arg-vars compiland)))
@@ -8568,15 +8568,15 @@
     (setf (method-max-locals execute-method) *registers-allocated*)
     (setf (method-handlers execute-method) (nreverse *handlers*))
 
-    (setf (class-file-superclass class-file)
+    (setf (abcl-class-file-superclass class-file)
           (if (or *hairy-arglist-p*
 		  (and *child-p* *closure-variables*))
 	      +lisp-compiled-closure-class+
 	    +lisp-primitive-class+))
 
-    (setf (class-file-lambda-list class-file) args)
+    (setf (abcl-class-file-lambda-list class-file) args)
 
-    (push execute-method (class-file-methods class-file)))
+    (push execute-method (abcl-class-file-methods class-file)))
   t)
 
 (defun compile-1 (compiland stream)

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Tue Feb  2 16:01:41 2010
@@ -89,7 +89,7 @@
 (defvar *declared-floats* nil)
 (defvar *declared-doubles* nil)
 
-(defstruct (class-file (:constructor %make-class-file))
+(defstruct (abcl-class-file (:constructor %make-abcl-class-file))
   pathname ; pathname of output file
   lambda-name
   class
@@ -134,38 +134,38 @@
   (let* ((class-name (if pathname
                          (class-name-from-filespec  pathname)
                          (make-unique-class-name)))
-         (class-file (%make-class-file :pathname pathname
-                                       :class class-name
-                                       :lambda-name lambda-name
-                                       :lambda-list lambda-list)))
+         (class-file (%make-abcl-class-file :pathname pathname
+                                            :class class-name
+                                            :lambda-name lambda-name
+                                            :lambda-list lambda-list)))
     class-file))
 
 (defmacro with-class-file (class-file &body body)
   (let ((var (gensym)))
     `(let* ((,var ,class-file)
-            (*pool*               (class-file-pool ,var))
-            (*pool-count*         (class-file-pool-count ,var))
-            (*pool-entries*       (class-file-pool-entries ,var))
-            (*fields*             (class-file-fields ,var))
-            (*static-code*        (class-file-static-code ,var))
-            (*declared-symbols*   (class-file-symbols ,var))
-            (*declared-functions* (class-file-functions ,var))
-            (*declared-strings*   (class-file-strings ,var))
-            (*declared-integers*  (class-file-integers ,var))
-            (*declared-floats*    (class-file-floats ,var))
-            (*declared-doubles*   (class-file-doubles ,var)))
+            (*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))
+            (*static-code*        (abcl-class-file-static-code ,var))
+            (*declared-symbols*   (abcl-class-file-symbols ,var))
+            (*declared-functions* (abcl-class-file-functions ,var))
+            (*declared-strings*   (abcl-class-file-strings ,var))
+            (*declared-integers*  (abcl-class-file-integers ,var))
+            (*declared-floats*    (abcl-class-file-floats ,var))
+            (*declared-doubles*   (abcl-class-file-doubles ,var)))
        (progn , at body)
-       (setf (class-file-pool ,var)         *pool*
-             (class-file-pool-count ,var)   *pool-count*
-             (class-file-pool-entries ,var) *pool-entries*
-             (class-file-fields ,var)       *fields*
-             (class-file-static-code ,var)  *static-code*
-             (class-file-symbols ,var)      *declared-symbols*
-             (class-file-functions ,var)    *declared-functions*
-             (class-file-strings ,var)      *declared-strings*
-             (class-file-integers ,var)     *declared-integers*
-             (class-file-floats ,var)       *declared-floats*
-             (class-file-doubles ,var)      *declared-doubles*))))
+       (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*
+             (abcl-class-file-symbols ,var)      *declared-symbols*
+             (abcl-class-file-functions ,var)    *declared-functions*
+             (abcl-class-file-strings ,var)      *declared-strings*
+             (abcl-class-file-integers ,var)     *declared-integers*
+             (abcl-class-file-floats ,var)       *declared-floats*
+             (abcl-class-file-doubles ,var)      *declared-doubles*))))
 
 (defstruct compiland
   name




More information about the armedbear-cvs mailing list