[armedbear-cvs] r12896 - branches/generic-class-file/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri Aug 13 17:51:26 2010
New Revision: 12896

Log:
Add source file and line number attributes according to the
new generator structure.

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

Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Fri Aug 13 17:51:26 2010
@@ -6939,6 +6939,10 @@
          (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))
       (push var *visible-variables*))

Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	(original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm-class-file.lisp	Fri Aug 13 17:51:26 2010
@@ -1208,14 +1208,15 @@
   )
 
 (defstruct line-number
-  start-pc  ;; a label, before finalization
+  start-pc  ;; a label, before finalization, or 0 for "start of function"
   line)
 
 (defun finalize-line-numbers (line-numbers code class)
   (declare (ignorable code class))
   (dolist (line-number (line-numbers-table line-numbers))
-    (setf (line-number-start-pc line-number)
-          (code-label-offset code (line-number-start-pc line-number)))))
+    (unless (zerop (line-number-start-pc line-number))
+      (setf (line-number-start-pc line-number)
+            (code-label-offset code (line-number-start-pc line-number))))))
 
 (defun write-line-numbers (line-numbers stream)
   (write-u2 (length (line-numbers-table line-numbers)) stream)
@@ -1223,7 +1224,9 @@
     (write-u2 (line-number-start-pc line-number) stream)
     (write-u2 (line-number-line line-number) stream)))
 
-
+(defun line-numbers-add-line (line-numbers start-pc line)
+  (push (make-line-number :start-pc start-pc :line line)
+        (line-numbers-table line-numbers)))
 
 (defstruct (local-variables-attribute
              (:conc-name local-var-)

Modified: branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp	(original)
+++ branches/generic-class-file/abcl/src/org/armedbear/lisp/jvm.lisp	Fri Aug 13 17:51:26 2010
@@ -161,6 +161,11 @@
                                             :class class-name
                                             :lambda-name lambda-name
                                             :lambda-list lambda-list)))
+    (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)