Put table entry classes in seperate packages, one per xdump parser

diff --git a/xdump.lisp b/xdump.lisp
index 8e099d815621b9643817e845e6339411b55583b0..eaa8ce125e9c03a0d4945835ebfb0b947a67733f 100644 (file)
--- a/xdump.lisp
+++ b/xdump.lisp
@@ -45,6 +45,8 @@
                   :initform (make-array 128
                                         :adjustable t
                                         :initial-element nil))
                   :initform (make-array 128
                                         :adjustable t
                                         :initial-element nil))

+   (table-classes-package :accessor table-classes-package
+                         :initform (make-package (gensym)))

    (index-by-name :accessor index-by-name
                  :initform (make-hash-table :size 128 :test 'equal))
    (meta-index :accessor meta-index :initform (make-array 5))
    (index-by-name :accessor index-by-name
                  :initform (make-hash-table :size 128 :test 'equal))
    (meta-index :accessor meta-index :initform (make-array 5))


@@ -125,7 +127,7 @@
 
        ;; create xdump-table instance and entry class
        (let* ((class-name (string-upcase (format nil "~a-table-entry" name)))
 
        ;; create xdump-table instance and entry class
        (let* ((class-name (string-upcase (format nil "~a-table-entry" name)))

-              (package (find-package "XDUMP-DATA"))
+              (package (table-classes-package parser))

               (table-instance (make-instance 'xdump-table
                                              :name name
                                              :index table-index
               (table-instance (make-instance 'xdump-table
                                              :name name
                                              :index table-index


@@ -139,13 +141,13 @@
          (eval (table-entry-defclass-form name class-name package
                                           slot-list)))))))
 
          (eval (table-entry-defclass-form name class-name package
                                           slot-list)))))))
 

-(defun entry-from-vector (class meta-table entry-vector)
+(defun entry-from-vector (class meta-table entry-vector table-classes-package)

   (let ((new-entry (make-instance class)))
     (loop
        for item in entry-vector
        for column across meta-table do
         (let ((slot (find-symbol (string-upcase (meta-name column))
   (let ((new-entry (make-instance class)))
     (loop
        for item in entry-vector
        for column across meta-table do
         (let ((slot (find-symbol (string-upcase (meta-name column))

-                                 (find-package "XDUMP-DATA"))))
+                                 table-classes-package)))

           (setf (slot-value new-entry slot) item)))
     new-entry))
 
           (setf (slot-value new-entry slot) item)))
     new-entry))
 


@@ -160,7 +162,7 @@
 
 (defun table-finalizer (parser)
   (with-slots (entry-buffer name timestamp index-by-name meta-by-index
 
 (defun table-finalizer (parser)
   (with-slots (entry-buffer name timestamp index-by-name meta-by-index

-                           table-by-index) parser
+                           table-by-index table-classes-package) parser

     (if (string= name "table") ; special magic: prefill index-by-name
        (loop for entry across entry-buffer do
             (setf (gethash (second entry) index-by-name) (first entry))))
     (if (string= name "table") ; special magic: prefill index-by-name
        (loop for entry across entry-buffer do
             (setf (gethash (second entry) index-by-name) (first entry))))


@@ -172,7 +174,8 @@
       (loop for entry across entry-buffer do
           (let ((entry-instance (entry-from-vector (table-entry-class table)
                                                    meta-table
       (loop for entry across entry-buffer do
           (let ((entry-instance (entry-from-vector (table-entry-class table)
                                                    meta-table

-                                                   entry)))
+                                                   entry
+                                                   table-classes-package)))

             (if has-uid-p
                 (let ((index (first entry)))
                   (table-entry-insert-at table entry-instance index))
             (if has-uid-p
                 (let ((index (first entry)))
                   (table-entry-insert-at table entry-instance index))