Changeset 12879

Timestamp:

08/08/10 21:24:03 (13 years ago)

Author:

ehuelsmann

Message:

Add 'dual mode' to DECLARE-FIELD.

Location:

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

Files:

• compiler-pass2.lisp (modified) (7 diffs)
• jvm.lisp (modified) (1 diff)

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

@@ -1276 +1276 @@
 
 (defknown declare-field (t t t) t)
-(defun declare-field (name descriptor access-flags)
-  (let ((field (make-field name (internal-field-ref 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)
+  (if *current-code-attribute*
+      (let ((field (!make-field name descriptor '(:final :static :private))))
+        (class-add-field *class-file* field))
+      (let ((field (make-field name (internal-field-ref descriptor))))
+        ;; final static <access-flags>
+        (setf (field-access-flags field)
+              (logior +field-flag-final+ +field-flag-static+
+                      +field-access-private+))
+        (setf (field-name-index field) (pool-name (field-name field)))
+        (setf (field-descriptor-index field)
+              (pool-name (field-descriptor field)))
+        (push field *fields*))))
 
 (defknown sanitize (symbol) string)
@@ -1468 +1473 @@
     ;; 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*)
 
@@ -1505 +1510 @@
      (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)
@@ -1558 +1563 @@
           (*code* *static-code*))
      ;; fixme *declare-inline*
-     (declare-field g +lisp-object+ +field-access-private+)
+     (declare-field g +lisp-object+)
      (emit-new class-name)
      (emit 'dup)
@@ -1583 +1588 @@
       ;; 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+ "readObjectFromString"
@@ -1603 +1608 @@
       ;; 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+ "readObjectFromString"
@@ -1627 +1632 @@
     (remember g obj)
     (let* ((*code* *static-code*))
-      (declare-field g +lisp-object+ +field-access-private+)
+      (declare-field g +lisp-object+)
       (emit 'ldc (pool-string g))
       (emit-invokestatic +lisp+ "recall"

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

@@ -83 +83 @@
 (defvar *fields* ())
 (defvar *static-code* ())
+(defvar *class-file* nil)
 
 (defvar *externalized-objects* nil)