Put table entry classes in seperate packages, one per xdump parser
authorGerd Flaig <gefla@rose.pond.sub.org>
Wed, 9 Feb 2011 22:55:24 +0000 (23:55 +0100)
committerGerd Flaig <gefla@rose.pond.sub.org>
Wed, 9 Feb 2011 22:55:24 +0000 (23:55 +0100)
xdump.lisp

index 8e099d815621b9643817e845e6339411b55583b0..eaa8ce125e9c03a0d4945835ebfb0b947a67733f 100644 (file)
@@ -45,6 +45,8 @@
                   :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))
 
        ;; 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
          (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))
-                                 (find-package "XDUMP-DATA"))))
+                                 table-classes-package)))
           (setf (slot-value new-entry slot) item)))
     new-entry))
 
 
 (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))))
       (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))