Changeset 13150

Timestamp:

01/15/11 19:49:11 (13 years ago)

Author:

ehuelsmann

Message:

Add basic support for compiler 'listeners' or callbacks:
infrastructure to help debug the compiler.

Location:

branches/unsafe-p-removal/abcl/src/org/armedbear/lisp

Files:

• jvm-class-file.lisp (modified) (2 diffs)
• jvm-instructions.lisp (modified) (1 diff)
• jvm.lisp (modified) (1 diff)

branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/jvm-class-file.lisp

@@ -1021 +1021 @@
 (defun finalize-code-attribute (code parent class)
   "Prepares the `code' attribute for serialization, within method `parent'."
-  (declare (ignore parent))
   (let* ((handlers (code-exception-handlers code))
          (c (finalize-code
@@ -1029 +1028 @@
                             (mapcar #'exception-handler-pc handlers))
                      t)))
+    (invoke-callbacks :code-finalized class parent
+                      (coerce c 'list) handlers)
     (unless (code-max-stack code)
       (setf (code-max-stack code)

branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/jvm-instructions.lisp

@@ -722 +722 @@
         (setf depth (+ depth instruction-stack))
         (setf (instruction-depth instruction) depth)
+        (unless (<= 0 depth)
+          (internal-compiler-error "Stack inconsistency detected ~
+                                    in ~A at index ~D: ~
+                                    negative depth ~S."
+                                   (compiland-name *current-compiland*)
+                                   i depth))
         (when (branch-p opcode)
           (let ((label (car (instruction-args instruction))))

branches/unsafe-p-removal/abcl/src/org/armedbear/lisp/jvm.lisp

@@ -54 +54 @@
 
 (defvar *enable-dformat* nil)
+(defvar *callbacks* nil
+  "A list of functions to be called by the compiler and code generator
+in order to generate 'compilation events'.")
+
+(declaim (inline invoke-callbacks))
+(defun invoke-callbacks (&rest args)
+  (dolist (cb *callbacks*)
+    (apply cb args)))
 
 #+nil