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

Timestamp:

07/29/10 18:27:10 (13 years ago)

Author:

ehuelsmann

Message:

Lots of fixes from writing tests. Most notable the correction of
my perception that the exceptions table was stored as an attribute
of the "Code" attribute. It's not: it's part of said attribute.

File:

• branches/generic-class-file/abcl/src/org/armedbear/lisp/compiler-pass2.lisp (modified) (6 diffs)

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

@@ -1305 +1305 @@
           (return-from walk-code))))))
 
-(declaim (ftype (function () t) analyze-stack))
-(defun analyze-stack ()
+(declaim (ftype (function (t) t) analyze-stack))
+(defun analyze-stack (code)
   (declare (optimize speed))
-  (let* ((code *code*)
-         (code-length (length code)))
+  (let* ((code-length (length code)))
     (declare (type vector code))
     (dotimes (i code-length)
@@ -1573 +1572 @@
 
 (defun code-bytes (code)
-  (let ((length 0))
+  (let ((length 0)
+        labels ;; alist
+        )
     (declare (type (unsigned-byte 16) length))
     ;; Pass 1: calculate label offsets and overall length.
@@ -1582 +1583 @@
         (if (= opcode 202) ; LABEL
             (let ((label (car (instruction-args instruction))))
-              (set label length))
+              (set label length)
+              (setf labels
+                    (acons label length labels)))
             (incf length (opcode-size opcode)))))
     ;; Pass 2: replace labels with calculated offsets.
@@ -1609 +1612 @@
               (setf (svref bytes index) byte)
               (incf index)))))
-      bytes)))
+      (values bytes labels))))
 
 (declaim (inline write-u1))
@@ -1879 +1882 @@
     (finalize-code)
     (setf *code* (resolve-instructions *code*))
-    (setf (method-max-stack constructor) (analyze-stack))
+    (setf (method-max-stack constructor) (analyze-stack *code*))
     (setf (method-code constructor) (code-bytes *code*))
     (setf (method-handlers constructor) (nreverse *handlers*))
@@ -8206 +8209 @@
 
     (setf *code* (resolve-instructions *code*))
-    (setf (method-max-stack execute-method) (analyze-stack))
+    (setf (method-max-stack execute-method) (analyze-stack *code*))
     (setf (method-code execute-method) (code-bytes *code*))